Run code on Folder and their subfolder

I have been using this code since couple of months and I have number of workbooks on which i apply this code to save the exact copy of that workbook with all data. I am doing this separately for eac...

Macros and VBA

HansVogelaar

Oct 06, 2021

ShazSh

Is this better?

Sub LoopFolder()
    Dim TopFolder As String
    Dim fso As Object
    Dim fld As Object
    Dim fil As Object
    With Application.FileDialog(4) ' msoFileDialogFolderPicker
        If .Show Then
            TopFolder = .SelectedItems(1) & "\"
        Else
            Beep
            Exit Sub
        End If
    End With
    Application.ScreenUpdating = False
    Set fso = CreateObject(Class:="Scripting.FileSystemObject")
    Set fld = fso.GetFolder(TopFolder)
    Call ProcessFolder(fld)
    Application.ScreenUpdating = True
End Sub

Sub ProcessFolder(ByVal fld As Object)
    Dim sfl As Object
    Dim fil As Object
    For Each fil In fld.Files
        If LCase(Right(fil.Name, 4)) = ".xls" Then
            Workbooks.Open fil.Name
            Call stuff
            ActiveWorkbook.Close
        End If
    Next fil
    For Each sfl In fld.SubFolders
        Call ProcessFolder(sfl)
    Next sfl
End Sub

Forum Discussion

Run code on Folder and their subfolder

Share

Resources