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

我在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-> References中添加对Windows Script Host对象模型的引用。 然后尝试下面的代码。

 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*"作为文件filter（我假设你只想要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