CODEWITHSUNDEEP
vbaexcel
Michael Sigman
Michael Sigman

Reputation: 39

Open workbooks in a folder and subfolders and update each

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

Upvotes: 2

Views: 3785

Answers (2)

SierraOscar
SierraOscar

Reputation: 17647

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

Upvotes: 0

area9
area9

Reputation: 391

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

Upvotes: 1

Related Questions