这个问题在这里已经有了答案:
Get list of sub-directories in VBA
(5 个回答)
2年前关闭。
我有一个文件夹,其中有许多子文件夹,其中包含 1000 多个 Excel 文件。
我想在所有这些文件上运行一个特定的宏(更改工作簿)。
已经看到下面的答案了。
Sub ProcessFiles()
Dim Filename, Pathname As String
Dim wb As Workbook
Pathname = ActiveWorkbook.Path & "\C:\...\EXCL\"
Filename = Dir(Pathname & "*.xlsx")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
DoWork wb
wb.Close SaveChanges:=True
Filename = Dir()
Loop
End Sub
Sub DoWork(wb As Workbook)
With wb
'Do your work here
......
End With
End Sub
有两个问题:
1. 这会非常慢。有更快的方法吗?
2. 这只会在匹配文件夹中的文件上运行,而不是在所有子文件夹中的文件上运行。有没有办法对子文件夹中的文件执行此操作?
最佳答案
据我所知,VBA 无法编辑壁橱工作簿。如果您想为每个子文件夹、子文件夹的子文件夹等中的每个工作簿工作,您可以使用以下代码。我添加了条件,它必须是 .xlsx
文件,您可以在 .xls
上更改它, .xlsb
或任何你想要的。
Sub ProcessFiles()
Dim objFolder As Object
Dim objFile As Object
Dim objFSO As Object
Dim MyPath As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo EmptyEnd
MyPath = .SelectedItems(1)
End With
Application.ScreenUpdating = False
Set objFSO = CreateObject("Scripting.FileSystemObject")
Call GetAllFiles(MyPath, objFSO)
Call GetAllFolders(MyPath, objFSO)
Application.ScreenUpdating = True
MsgBox "Complete."
EmptyEnd:
End Sub
Sub GetAllFiles(ByVal strPath As String, ByRef objFSO As Object)
Dim objFolder As Object
Dim objFile As Object
Set objFolder = objFSO.GetFolder(strPath)
For Each objFile In objFolder.Files
DoWork objFile.Path
Next objFile
End Sub
Sub GetAllFolders(ByVal strFolder As String, ByRef objFSO As Object)
Dim objFolder As Object
Dim objSubFolder As Object
Set objFolder = objFSO.GetFolder(strFolder)
For Each objSubFolder In objFolder.subfolders
Call GetAllFiles(objSubFolder.Path, objFSO)
Call GetAllFolders(objSubFolder.Path, objFSO)
Next objSubFolder
End Sub
Sub DoWork(strFile As String)
Dim wb As Workbook
If Right(strFile, 4) = "xlsx" Then
Set wb = Workbooks.Open(Filename:=strFile)
With wb
'Do your work here
......
.Close True
End With
End If
End Sub
关于excel - 在文件夹和子文件夹内的所有文件上递归运行 excel 宏代码,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/41345805/