除非注明,，文章均為 戰(zhàn)戰(zhàn)如瘋 原創(chuàng),，轉載請保留鏈接: http://www./cat4/106.html,，VBA交流群273624828,。

前面我們學習了將同一文件夾下的多個工作簿匯總到一張表中,，今天我們來學習怎么將多個文件夾中的Excel工作簿匯總到一個工作表中,。假設我現(xiàn)在有4個文件夾,，每個當中都有若干個工作簿，現(xiàn)在我要將這些工作簿中的內容匯總到一個工作表中,。提取工作簿中的內容我們仍然使用GetObject方法,，遍歷我們用的仍然是Dir方法，只不過我們這次在遍歷Excel工作簿之前首先要遍歷當前文件夾下的所有文件夾,，看下面的代碼

Sub Macro1()
Dim mypath, myfile, m, j, wb, arr()
Sheet1.UsedRange.Offset(1, 0).ClearContents
mypath = ThisWorkbook.Path & "\"
myfile = Dir(mypath, vbDirectory) '遍歷mypath路徑下的所有文件夾
Do While myfile <> "" '當返回值不為空時
If myfile <> "." And myfile <> ".." Then '當返回值不是"."（當前文件夾）或".."（上層文件夾）
If (GetAttr(mypath & myfile) And vbDirectory) = vbDirectory Then '如果得到的是文件夾
m = m + 1 '計算器
ReDim Preserve arr(m) '重定義數(shù)組arr
arr(m) = mypath & myfile & "\"
End If
End If
myfile = Dir '查找下一個文件夾
Loop
'至此所有文件夾路徑已放在數(shù)組arr中
'下面開始遍歷每個文件夾中的excel文件
For j = 1 To m
myfile = Dir(arr(j) & "*.xlsx")
While myfile <> ""
Set wb = CreateObject(arr(j) & myfile)
With wb.Sheets(1)
.UsedRange.Offset(1, 0).Copy Sheet1.Range("A" & Sheet1.[a1048576].End(xlUp).Row + 1)
End With
wb.Close
myfile = Dir()
Wend
Next
Set wb = Nothing
End Sub

Dir(mypath, vbDirectory) 就是遍歷尋找當前文件夾下的所有文件夾,，只不過遍歷時存在兩個特殊的文件夾，即當前文件夾和上層文件夾,，分別用單點號和雙點號表示,，這也是為什么要加上If myfile <> "." And myfile <> ".." Then這句判斷的原因。GetAttr(mypath & myfile)是返回文件的一系列屬性,，vbDirectory只是眾多屬性中的一個，所以用了GetAttr(mypath & myfile) And vbDirectory來判斷取得的是不是文件夾,，之后將所得的文件夾路徑放在數(shù)組arr中,。當所有的文件夾路徑都保存下來之后就開始對每個文件夾進行依次遍歷，下面就和之前講的多個Excel工作簿中內容匯總到一個Excel中相同了,，只不過多了一個循環(huán)而已,。

示例文件下載地址：http://pan.baidu.com/s/1i3kRbNJ