VBA循环遍历多个文件夹

Question

  

可能重复：
  get list of subdirs in 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

Answer 1

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

将LoopF​​iles方法更改为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

然后为LoopDirecotries方法中的每个文件夹调用LoopF​​iles方法。