Styjun

I have the following code that will open/save/close any/all workbooks in a folder. It works great, however, I also need it to include sub folders. The code needs to work without restrictions on the number of folders, sub folders and files, if possible.

I'm working with Excel 2010 and I'm new to VBA - would really appreciate any help!

Sub File_Loop_Example()
 'Excel VBA code to loop through files in a folder with Excel VBA

 Dim MyFolder As String, MyFile As String

 'Opens a file dialog box for user to select a folder

 With Application.FileDialog(msoFileDialogFolderPicker)
 .AllowMultiSelect = False
 .Show
 MyFolder = .SelectedItems(1)
 Err.Clear
 End With

 'stops screen updating, calculations, events, and statsu bar updates to help code run faster
 'you'll be opening and closing many files so this will prevent your screen from displaying that

 Application.ScreenUpdating = False
 Application.DisplayStatusBar = False
 Application.EnableEvents = False
 Application.Calculation = xlCalculationManual

 'This section will loop through and open each file in the folder you selected
 'and then close that file before opening the next file

 MyFile = Dir(MyFolder & "", vbReadOnly)

 Do While MyFile <> ""
 DoEvents
 On Error GoTo 0
 Workbooks.Open Filename:=MyFolder & "" & MyFile, UpdateLinks:=False
 ActiveWorkbook.Save
 Workbooks(MyFile).Close SaveChanges:=True
 MyFile = Dir
 Loop

 'turns settings back on that you turned off before looping folders

 Application.ScreenUpdating = True
 Application.DisplayStatusBar = True
 Application.EnableEvents = True
 Application.Calculation = xlCalculationManual

 MsgBox "Done!"

 End Sub

For anyone interested, I found an alternative which I managed to adapt and does exactly what I want:

Sub Loop_Example()

Dim MyFolder As String
Dim file As Variant, wb As Excel.Workbook

With Application.FileDialog(msoFileDialogFolderPicker)
 .AllowMultiSelect = False
 .Show
 MyFolder = .SelectedItems(1)
 Err.Clear
 End With

Application.ScreenUpdating = False

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)
 ActiveWorkbook.Save
 wb.Close SaveChanges:=True
 Set wb = Nothing
Next

Application.ScreenUpdating = True

 MsgBox "Done!"

End Sub