Forum Discussion

Brass Contributor

Oct 06, 2021

Solved

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

HansVogelaar

MVP

Oct 06, 2021

ShazSh

Try this. Change the path in LoopFolder to the folder you want to process.

The code calls your Stuff macro.

Sub LoopFolder()
    Const TopFolder = "C:\Excel\"
    Dim fso As Object
    Dim fld As Object
    Dim fil As Object
    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

ShazSh

Brass Contributor

Oct 06, 2021

Sir its not working that way and i have updated the Folder address into "Const TopFolder = " but its not working.

I would request please update the code so it can ask me to select particular folder and it should run on all workbooks and subfolder workbooks. Looking forward to your help.

HansVogelaar

MVP

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

ShazSh
Brass Contributor
Oct 08, 2021
When i run this code it gives me an option to select the folder after selecting the folder it does nothing. I do not know why. I have added my above code Stuff. But still not working.