VBA Opening Subfolders within a folder, do some work on it then save & close.

[TK289]

Hi all,

I am very new to VBA and wanted to ask if you can help me with below. It might be the simplest thing in the world but I can't figure it out.
I have found this code online and amended it so that it opens, do some work on the files within a selected folder then save & close for all files in a folder (Names are random). I can use this code to run it for a folder at a time but I have hundreds of folders to go through so I was wondering if there is a way to open all folders within a folder to run this code? It can be in any order as long as it covers all sub folders and files within that sub folder.

Your help would be very much appreciate

Sub LoopAllExcelFilesInFolder()

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

  Application.ScreenUpdating = False
  Application.EnableEvents = False

  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

  myFile = Dir(myPath & myExtension)

  Do While myFile <> ""
      Set wb = Workbooks.Open(Filename:=myPath & myFile)

      DoEvents
  
'My VBA code is here but for the sake of code length, I will have it hidden'
  
      wb.Close SaveChanges:=True

      DoEvents

      myFile = Dir
  Loop

  MsgBox "Task Complete!"

ResetSettings:
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

 

[John_w]

You need a macro which uses FileSystemObject to recursively loop through the subfolders and open each workbook. I've used the Like operator in the If statement to open only the workbooks which match the matchWorkbooks argument (a wildcard file name spec, e.g. *.xlsx, as in the code), but you can remove the matchWorkbooks parameter and the If statement and its associated End If if you want to open any workbook file.

Option Explicit

'Late binding version

Public Sub Open_All_Workbooks_In_Folders()
       
    Dim FldrPicker As FileDialog

    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
        
        .Title = "Select A Target Folder"
        .AllowMultiSelect = False
        
        If .Show Then
            
            Application.ScreenUpdating = False
            Application.EnableEvents = False
            
            Open_Workbooks_In_Folder .SelectedItems(1), "*.xlsx"
            
            Application.ScreenUpdating = False
            Application.EnableEvents = False
            
            MsgBox "Done"
        
        End If
        
    End With
       
End Sub


Private Sub Open_Workbooks_In_Folder(folderPath As String, matchWorkbooks As String)

    Static FSO As Object
    Dim thisFolder As Object, subfolder As Object
    Dim thisFile As Object
    Dim wb As Workbook
    
    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
    
    Set thisFolder = FSO.GetFolder(folderPath)
        
    For Each thisFile In thisFolder.Files
        If LCase(thisFile.Name) Like LCase(matchWorkbooks) Then
        
            Set wb = Workbooks.Open(thisFile.Path)

            'My VBA code is here but for the sake of code length, I will have it hidden'
  
            wb.Close SaveChanges:=False 'True

            DoEvents
        End If
    Next
    
    'Do subfolders
    
    For Each subfolder In thisFolder.SubFolders
        Open_Workbooks_In_Folder subfolder.Path, matchWorkbooks
    Next
    
End Sub

 

[JEC]

This will also do. Only change the folderpath.
This code will loop through each xls* file in that folder, including the files in subfolders

Sub jec()
  Dim a As Variant, i As Long, myPath As String
  Application.ScreenUpdating = False
  myPath = "C:\Users\xxxx\Documents\Your Folder\*xls"
  a = Split(CreateObject("wscript.shell").Exec("cmd /c Dir  """ & myPath & """  /s/b").StdOut.ReadAll, vbCrLf)
 
  If IsArray(a) Then
    For i = 0 To UBound(a)
       With Workbooks.Open(a(i))
          .Sheets(1).Range("Z1") = "test"           'your change
          .Close 1
       End With
     Next
  End If
End Sub

 

[TK289]

It worked like magic!
Thanks guys!

 

[BukiSP84]

I am retrying others code & problems. When I run the code by @John_w , why does it close all the workbooks immediately?

 

[John_w]

Because of this comment in OP's code:

'My VBA code is here but for the sake of code length, I will have it hidden'

i.e. he/she deleted the code which operates on the opened workbooks.