给一个笨笨的办法，使用 DIR!
'以查找D:\盘下所有EXCEL文件为例
Sub M_dir()'这是一个主模块，中间调用两人子模块，一个遍历指定目录下的所有文件夹，一个遍历文件夹下的所有EXCEL文件
Application.DisplayAlerts = False
Application.ScreenUpdating = False
On Error Resume Next
Sheets.Add.Name = "路径"
If Err.Number <> 0 Then
ActiveSheet.Delete
Sheets("路径").Cells.Delete
Err.Clear: On Error GoTo 0
End If
Set Sh = Sheets("路径")
Sh.[a1] = "D:\" '以查找D盘下所有EXCEL文件为例
i = 1
Do While Sh.Cells(i, 1) <> ""
dirdir (Sh.Cells(i, 1))
i = i + 1
Loop
On Error Resume Next
Sheets.Add.Name = "XLS文件"
If Err.Number <> 0 Then
ActiveSheet.Delete
Sheets("XLS文件").Cells.Delete
Err.Clear: On Error GoTo 0
End If
Set sh2 = Sheets("XLS文件")
sh2.Cells(1, 1) = "文件清单"
For Each cel In Sh.[a1].CurrentRegion
Call dirf(cel.Value)
Next
End Sub
Sub dirf(My_Path)'遍历文件夹下的所有EXCEL文件
Set sh2 = Sheets("XLS文件")
mm = sh2.[a65536].End(xlUp).Row + 1
MyFilename = Dir(My_Path & "*.xl*")
Do While MyFilename <> ""
sh2.Cells(mm, 1) = My_Path & MyFilename
mm = mm + 1
MyFilename = Dir
Loop
End Sub
Sub dirdir(MyPath)'遍历指定目录下的所有文件夹
Dim MyName
Set Sh = Sheets("路径")
MyName = Dir(MyPath, vbDirectory)
m = Sh.[a65536].End(xlUp).Row + 1
Do While MyName <> ""
If MyName <> "." And MyName <> ".." Then
If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
Sh.Cells(m, 1) = MyPath & MyName & "\"
m = m + 1
End If
End If
MyName = Dir
Loop
End Sub
ttt.rar （7个子文件） 
ttt 
VB 遍历指定目录及子目录所有文件函数_Visual Basic_新兴网络.mht 163KB 请问如何用vb遍历一个文件夹下的所有文件包括自文件夹 - VB - 基础类.mht 395KB Excel [求助]如何用VBA遍历指定目录下的所有子文件夹和文件 - ExcelVBA程序开发 - Excel Home论坛.mht 556KB
1.txt 2KB
1.doc 160KB VB 如何遍历文件夹下所有文件，高手请指教_百度知道.mht 224KB VB遍历某目录下的某类型文件(Dir) - 鞠勇鸿的技术专栏 - CSDN博客.mht 242KB资源评论
