I've tried to cobble together some code based on snippets given by the
experts here to run one or more macros on all the files in a folder.
Unfortunately, it keeps opening and and closing each file in an infinite Dir
loop. Can anyone see what's going wrong? I've tried all sorts of things to no
avail.
Any help much appreciated.
David Turner
Sub BatchRun()
Application.ScreenUpdating = False
Dim strFileName As String
Dim strPath As String
Dim sOrgPath As String
Dim oDoc As Document
Dim fDialog As FileDialog
Dim macroList() As String
Dim macroName As String
Dim k As Long
Dim FileArray()
Dim f As Long
ReDim macroList(0)
sOrgPath = Options.DefaultFilePath(wdDocumentsPath)
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.InitialFileName = sOrgPath
.Title = "Select folder and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User", , "BatchRun"
Exit Sub
End If
strPath = fDialog.SelectedItems.Item(1)
If Right(strPath, 1) <> "\" Then strPath = strPath + "\"
End With
Do
macroName = InputBox("Enter the name of the macro that you want to
run.", "Macro Name", "Macro1")
If Len(macroName) = 0 Then
MsgBox ("Nothing entered. Exiting routine.")
Exit Sub
Else
macroList(UBound(macroList)) = macroName
ReDim Preserve macroList(UBound(macroList) + 1)
End If
Loop While MsgBox("Do you want to run an additional macro?", vbYesNo +
vbQuestion, _
"More macros?") = vbYes
f = 0
strFileName = Dir$(strPath & "*.doc")
Do While (Len(strFileName) > 0)
Set oDoc = Documents.Open(strPath & strFileName)
For k = 0 To UBound(macroList) - 1
Application.Run macroList(k)
Next k
oDoc.Save
oDoc.Close
Set oDoc = Nothing
f = f + 1
ReDim Preserve FileArray(1 To f)
FileArray(f) = strFileName
strFileName = Dir$()
Loop
Application.ScreenUpdating = True
MsgBox "All Done"
End Sub