View Single Post
 
Old 08-13-2015, 06:12 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

There's nothing inherently 'wrong' with your code, though it could be made a little more efficient:
Code:
Sub Batch_Insert_Text_End_of_File()
Application.ScreenUpdating = False
Dim strInFold As String, strOutFold As String, strFile As String, strOutFile As String, DocSrc As Document
Dim i As Long
'Call the GetFolder Function to determine the folder to process
strInFold = GetFolder
If strInFold = "" Then Exit Sub
strFile = Dir(strInFold & "\*.txt", vbNormal)
'Check for documents in the folder - exit if none found
If strFile <> "" Then strOutFold = strInFold & "\Output\"
'Test for an existing outpfolder & create one if it doesn't already exist
If Dir(strOutFold, vbDirectory) = "" Then MkDir strOutFold
strFile = Dir(strInFold & "\*.txt", vbNormal)
'Process all documents in the chosen folder
While strFile <> ""
    Set DocSrc = Documents.Open(FileName:=strInFold & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
    With DocSrc
      i = i + 1 'counter for index
      .Range.InsertAfter vbCrLf & _
        " 45 CALCULATE, 'BLIN-ARRAY-SIZE' = XXX $" & vbCrLf & " 50 END, 'INIT_TABLE_" & i & "' $"
      .SaveAs FileName:=strOutFold & .Name, FileFormat:=wdFormatText, AddToRecentFiles:=False
      .Close
    End With
    strFile = Dir()
Wend
Set Rng = Nothing: Set DocSrc = Nothing
Application.ScreenUpdating = True
End Sub
 
Function GetFolder(Optional Title As String, Optional RootFolder As Variant) As String
On Error Resume Next
GetFolder = CreateObject("Shell.Application").BrowseForFolder(0, Title, 0, RootFolder).Items.Item.Path
End Function
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote