如何用VBA遍历指定目录下的所有子文件夹<em>Excel</em>文件的所有...-文件列表

可以在Excel表格中百用下面的度VBA程序实现：知
Sub Test() '打开当前目录下道文件，将Sheet1信息版复制到汇总表上权
Dim f$
Dim n&
Mypath = ThisWorkbook.Path & "\"
f = Dir(Mypath & "*.xls*")
Do While f > " "
n = n + 1

Workbooks.Open Mypath & f
Set c = ActiveWorkbook
arr=sheet1.UsedRange
c.Close
Cells(n, 1).resze(Ubound(arr,1),Ubound(arr,2)) =arr
n=n+Ubound(arr,1)
f = Dir

Loop
End Sub

Private Function ListFile(MuLu As String, Zi As Boolean, Optional LeiXing As String = "")

Dim MyFile As String, ms As String
Dim arr, brr, x
Dim i As Integer
Set d = CreateObject("Scripting.Dictionary")
If Right(MuLu, 1) <> "\" Then MuLu = MuLu & "\"
d.Add MuLu, ""
i = 0
Do While i < d.Count
    brr = d.keys
    MyFile = Dir(brr(i), vbDirectory)
    Do While MyFile <> ""
        If MyFile <> "." And MyFile <> ".." Then
            If (GetAttr(brr(i) & MyFile) And vbDirectory) = vbDirectory Then d.Add (brr(i) & MyFile & "\"), ""
        End If
        MyFile = Dir
    Loop
    If Zi = False Then Exit Do
    i = i + 1
Loop
If LeiXing = "" Then
    ListFile = Application.Transpose(d.keys)
Else
    For Each x In d.keys
        MyFile = Dir(x & LeiXing)
        Do While MyFile <> ""
            ms = ms & x & MyFile & ","
            MyFile = Dir
        Loop
        If Zi = False Then Exit For
    Next
    If ms = "" Then ms = "没有符合要求的文件,"
    ListFile = Application.Transpose(Split(ms, ","))
End If
Set d = Nothing
End Function

这个是我找到（抄袭）的一段代码，查找文件夹下面的子文e69da5e887aa7a686964616f364件夹，文件的，我想你应该需要这个，列出子文件夹，然后所有遍历，三个参数，mulu是指定的路径，zi是是否查询子文件夹，leixin是文件类型，少少修改应该能满足你的需求

这是我搜索来的，希望对您有所帮助。

【解决方案】：

1.将所有格e799bee5baa6e79fa5e98193e4b893e5b19e339式相同的Excel表格保存到一个文件夹内；

2.在文件夹内新建一个Excel工作表，命名为“汇总表”；

3.打开汇总表，按“Alt + F11”打开VBA开发环境，双击工程资源管理器里面的sheet1(sheet1),在右侧的代码区编写如下代码：

Sub 合并当前目录下所有工作簿的全部工作表()
Dim MyPath, MyName, AWbName
Dim Wb As Workbook, WbN As String
Dim G As Long
Dim Num, ini As Long
Application.ScreenUpdating = False
MyPath = ActiveWorkbook.Path
MyName = Dir(MyPath & "\" & "*.xls")
AWbName = ActiveWorkbook.Name
Num = 0
ini = 0
Do While MyName <> ""
If MyName <> AWbName Then
Set Wb = Workbooks.Open(MyPath & "\" & MyName)
Num = Num + 1
With Workbooks(1).ActiveSheet
If ini = 0 Then
Wb.Sheets(1).Range(Wb.Sheets(1).Cells(1,1),Wb.Sheets(1).Cells(1,Wb.Sheets(1).UsedRange.Columns.Count)).Copy .Cells(1, 1)
ini=1
End If
For G=1 To Sheets.Count
Wb.Sheets(G).Range(Wb.Sheets(G).Cells(2,1),Wb.Sheets(G).Cells(Wb.Sheets(G).UsedRange.Rows.Count,Wb.Sheets(G).UsedRange.Columns.Count)).Copy .Cells(.Range("A65536").End(xlUp).Row+1,1)
Next
WbN=WbN & Chr(13) & Wb.Name
Wb.Close False
End With
End If
MyName=Dir
Loop
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
End Sub

4.运行代码，系统会自动将所有Excel表格合并到“汇总表”中。

参考资料：

wenda.tianya.cn/question/1421a43af56f4c4e
hi.baidu.com/num006/item/1a5658f8039b812c753c4c68

可以用一个小软件Everything，检索速度相当快，很常见，在知百度或者360安全卫士都可以找到。

打开软件点“搜索”-“管理筛选器”-“新建”，名称框填“Excel文件”，并勾选“正则表达式”，搜索框里填[.](xls|xlsx|xlsm)$

（↑excel工作表类型不止道xls、xlsx、xlsm这三种，可以按需要自己加）

点击确定之后，在软件的搜索框右边，筛选器里面就多了一个“版Excel文件”的选项。在搜索框里粘贴要查找的路径，就可以显示所有excel工作表了。在搜索结果里面还可以选中之后点右键，批量复制保存文件名和路径。权