vba - VBA Loop through multiple folders

Question

Possible Duplicate:
get list of subdirs in vba

I'm trying to apply the following code, which applies to running this VBA loop through all files in a folder, to make it run through all folders within one folder.

Is there any way that this is possible?

I have about 50 folders, each with the same named workbook, so I'd need to try and make it more efficient.

Thanks!

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 方法更改为接受目录参数：

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 方法。