|
除非注明，文章均为 战战如疯 原创，转载请保留链接: http://www./cat4/106.html，VBA交流群273624828。
前面我们学习了将同一文件夹下的多个工作簿汇总到一张表中，今天我们来学习怎么将多个文件夹中的Excel工作簿汇总到一个工作表中。假设我现在有4个文件夹，每个当中都有若干个工作簿，现在我要将这些工作簿中的内容汇总到一个工作表中。提取工作簿中的内容我们仍然使用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) '重定义数组arr
arr(m) = mypath & myfile & "\"
End If
End If
myfile = Dir '查找下一个文件夹
Loop
'至此所有文件夹路径已放在数组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来判断取得的是不是文件夹，之后将所得的文件夹路径放在数组arr中。当所有的文件夹路径都保存下来之后就开始对每个文件夹进行依次遍历，下面就和之前讲的多个Excel工作簿中内容汇总到一个Excel中相同了，只不过多了一个循环而已。
示例文件下载地址：http://pan.baidu.com/s/1i3kRbNJ
|
