Open workbooks in a folder and subfolders and update each - vba

Question

I am running the following VBA in Ecel to open a folder and then update all Excel sheets within this folder. However I would like it to include all subfolders as well.
Sub AllWorkbooks()
Dim MyFolder As String 'Path collected from the folder picker dialog
Dim MyFile As String 'Filename obtained by DIR function
Dim wbk As Workbook 'Used to loop through each workbook
On Error Resume Next
Application.ScreenUpdating = False
'Opens the folder picker dialog to allow user selection
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder"
.Show
.AllowMultiSelect = False
If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
MsgBox "You did not select a folder"
Exit Sub
End If
MyFolder = .SelectedItems(1) & "\" 'Assign selected folder to MyFolder
End With
MyFile = Dir(MyFolder) 'DIR gets the first file of the folder
'Loop through all files in a folder until DIR cannot find anymore
Do While MyFile <> “”
'Opens the file and assigns to the wbk variable for future use
Set wbk = Workbooks.Open(Filename:=MyFolder & MyFile)
'Replace the line below with the statements you would want your macro to perform
ActiveWorkbook.RefreshAll
Application.Wait (Now + TimeValue("0:00:05"))
wbk.Close savechanges:=True
MyFile = Dir 'DIR gets the next file in the folder
Loop
Application.ScreenUpdating = True
End Sub

Answer 1

Ok, you'll need to use the FileSystemObject and add a reference to the Windows Script Host Object Model in Tools->References. Then try the code below.
Sub AllWorkbooks()
Dim MyFolder As String 'Path collected from the folder picker dialog
Dim MyFile As String 'Filename obtained by DIR function
Dim wbk As Workbook 'Used to loop through each workbook
Dim FSO As New FileSystemObject ' Requires "Windows Script Host Object Model" in Tools -> References
Dim ParentFolder As Object, ChildFolder As Object
On Error Resume Next
Application.ScreenUpdating = False
'Opens the folder picker dialog to allow user selection
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder"
.Show
.AllowMultiSelect = False
If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
MsgBox "You did not select a folder"
Exit Sub
End If
MyFolder = .SelectedItems(1) & "\" 'Assign selected folder to MyFolder
End With
MyFile = Dir(MyFolder) 'DIR gets the first file of the folder
'Loop through all files in a folder until DIR cannot find anymore
Do While MyFile <> ""
'Opens the file and assigns to the wbk variable for future use
Set wbk = Workbooks.Open(Filename:=MyFolder & MyFile)
'Replace the line below with the statements you would want your macro to perform
ActiveWorkbook.RefreshAll
Application.Wait (Now + TimeValue("0:00:05"))
wbk.Close savechanges:=True
MyFile = Dir 'DIR gets the next file in the folder
Loop
For Each ChildFolder In FSO.GetFolder(MyFolder).SubFolders
MyFile = Dir(MyFolder & ChildFolder.Name) 'DIR gets the first file of the folder
'Loop through all files in a folder until DIR cannot find anymore
Do While MyFile <> ""
'Opens the file and assigns to the wbk variable for future use
Set wbk = Workbooks.Open(Filename:=MyFolder & ChildFolder.Name & "\" & MyFile)
'Replace the line below with the statements you would want your macro to perform
ActiveWorkbook.RefreshAll
Application.Wait (Now + TimeValue("0:00:05"))
wbk.Close savechanges:=True
MyFile = Dir 'DIR gets the next file in the folder
Loop
Next ChildFolder
Application.ScreenUpdating = True
End Sub

Answer 2

Or, you can just use CMD and read the output, much faster for drilling down through subfolders.
I've used ".xl*" as the file filter (I assume you only want Excel files?) but change this as you see fit:
Sub MM()
Const startFolder As String = "C:\Users\MacroMan\Folders\" '// note trailing '\'
Dim file As Variant, wb As Excel.Workbook
For Each file In Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR """ & startFolder & "*.xl*"" /S /B /A:-D").StdOut.ReadAll, vbCrLf), ".")
Set wb = Workbooks.Open(file)
'// Do what you want here with the workbook
wb.Close SaveChanges:=True '// or false...
Set wb = Nothing
Next
End Sub