Question

我在Ecel中运行以下VBA以打开文件夹，然后更新此文件夹中的所有Excel工作表。但是我希望它也包含所有子文件夹。

 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

Answer 1

好的，您需要使用FileSystemObject并在Tools-＆gt; References中添加对Windows Script Host Object Model的引用。然后尝试下面的代码。

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

Answer 2

或者，您只需使用CMD并读取输出，就可以更快地向下钻取子文件夹。

我使用".xl*"作为文件过滤器（我假设您只想要Excel文件？）但是根据您的需要更改此内容：

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

在文件夹和子文件夹中打开工作簿并更新每个工作簿

2 个答案: