VBA在多个文件夹中循环

可能重复：

我正在尝试应用以下代码，该代码适用于在文件夹中的所有文件中运行此VBA循环，使其在一个文件夹中的所有文件夹中运行

这有可能吗

我有大约50个文件夹，每个文件夹都有相同名称的工作簿，所以我需要尝试提高它的效率

谢谢

Sub LoopFiles()

    Application.DisplayAlerts = False    
    Dim strDir As String, strFileName As String
    Dim wbCopyBook As Workbook
    Dim wbNewBook As Workbook

    strDir = "C:\Documents and Settings\mburke\Desktop\Occupancy 2013\"
    strFileName = Dir(strDir & "*.xlsm")

    Set wbNewBook = Workbooks.Add

    Do While strFileName <> ""
        Set wbCopyBook = Workbooks.Open(strDir & strFileName)
        wbCopyBook.Sheets(1).Copy Before:=wbNewBook.Sheets(1)
        wbCopyBook.Close False
        strFileName = Dir
    Loop

    Application.DisplayAlerts = True
End Sub

子循环文件（）
Application.DisplayAlerts=False
Dim strDir作为字符串，strFileName作为字符串
将复印机设置为工作簿
将新书本设置为工作簿
strDir=“C:\Documents and Settings\mburke\Desktop\occulation 2013\”
strFileName=Dir（strDir&“*.xlsm”）
设置wbNewBook=工作簿。添加
当strFileName“”时执行此操作
设置wbCopyBook=Workbooks.Open（strDir&strFileName）
wbCopyBook.Sheets（1）.之前复制：=wbNewBook.Sheets（1）
wbCopyBook。关闭False
strFileName=Dir
环
Application.DisplayAlerts=True
端接头

当然可以！只需添加另一个LoopDirectories方法，对文件夹执行DIR

将LoopFiles方法更改为bir以接受目录参数：

Sub LoopFiles(directory As String)

    Application.DisplayAlerts = False

    Dim strDir As String, strFileName As String
    Dim wbCopyBook As Workbook
    Dim wbNewBook As Workbook


    strFileName = Dir(directory & "*.xlsm")

    Set wbNewBook = Workbooks.Add

    Do While strFileName <> ""
        Set wbCopyBook = Workbooks.Open(directory & strFileName)
        wbCopyBook.Sheets(1).Copy Before:=wbNewBook.Sheets(1)
        wbCopyBook.Close False
        strFileName = Dir
    Loop

    Application.DisplayAlerts = True
End Sub

子循环文件（目录为字符串）
Application.DisplayAlerts=False
Dim strDir作为字符串，strFileName作为字符串
将复印机设置为工作簿
将新书本设置为工作簿
strFileName=Dir（目录&“*.xlsm”）
设置wbNewBook=工作簿。添加
当strFileName“”时执行此操作
设置wbCopyBook=Workbooks.Open（目录和strFileName）
wbCopyBook.Sheets（1）.之前复制：=wbNewBook.Sheets（1）
wbCopyBook。关闭False
strFileName=Dir
环
Application.DisplayAlerts=True
端接头

---

然后在LoopDiRecorties方法中为每个文件夹调用LoopFiles方法。

50个文件夹是否都在主模具下方的文件夹中，还是“嵌套”在两层或更多层中？您将需要对Laters进行递归调用。有关递归目录调用方法，请参见此查看

ProcessFiles（）

函数，该函数基于从vbaexpress.com获取的代码，但这并没有解释如何调用每个文件夹