Sub aa()Dim MyFile, MyPath, MyNameMyPath = “c:\abc\“ ’ 指定路径。MyName = Dir(MyPath, vbDirectory) ’ 找寻第一项。Do While MyName 《》 ““ ’ 开始循环。 ’ 跳过当前的目录及上层目录。 If MyName 《》 “.“ And MyName 《》 “..“ Then ’ 使用位比较来确定 MyName 代表一目录或者文件夹。 If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory And MyName = “目标“ Then Debug.Print MyName ’ 如果它是一个文件夹，且名称为“目标“,将其名称显示出来。 End If End If MyName = Dir ’ 查找下一个目录。LoopEnd Sub 若非要使用FileSearch方法,就需要使用FileSearch下面的属性:SearchFolders这样子的Application.FileSearch.SearchFolders,具体用法详见excel帮助

需要两个参数，一个是路径名，另一个是文件名。使用时请先试验，并先保存或备份文档以防出错。另外，检索文件可能会花费较长时间，请留意。Function SearchFile(ByVal DirName As String, ByVal FileName As String)Dim S$, Paths As String, V, I&If Right(DirName, 1) 《》 “\“ Then DirName = DirName + “\“S = Dir(DirName + FileName)If S 《》 ““ Then SearchFile = DirName + S Exit FunctionEnd IfS = Dir(DirName, 16)Paths = ““Do While S 《》 ““ If S 《》 “.“ And S 《》 “..“ Then If GetAttr(DirName + S) = vbDirectory Then Paths = Paths + S + “|“ S = DirLoopV = Split(Paths, “|“)For I = LBound(V) To UBound(V) - 1 S = SearchFile(DirName + V(I), FileName) If S 《》 “No file found“ Then SearchFile = S Exit Function End IfNext IlExit: SearchFile = “No file found“End Function

VBA遍历文件夹常用有三种方法，这三种方法中,filesearch不适合2007和2010版本，而且速度比较慢，递归法速度也慢。只有用DIR加循环的方法，速度飞快。下面是三种方法的代码：1、filesearch法Sub test3()Dim wb As WorkbookDim i As LongDim tt = Timer With Application.FileSearch ’调用fileserch对象 .NewSearch ’开始新的搜索 .LookIn = ThisWorkbook.path ’设置搜索的路径 .SearchSubFolders = True ’搜索范围包括 LookIn 属性指定的文件夹中的所有子文件夹 .Filename = “*.xls“ ’设置搜索的文件类型 ’ .FileType = msoFileTypeExcelWorkbooks If .Execute() 》 0 Then ’如果找到文件 For i = 1 To .FoundFiles.Count ’On Error Resume Next Cells(i, 1) = .FoundFiles(i) ’把找到的文件放在单元格里 Next i Else MsgBox “没找到文件“ End If End With MsgBox Timer - tEnd Sub2、递归法 Sub Test()Dim iPath As String, i As LongDim tt = Timer With Application.FileDialog(msoFileDialogFolderPicker) .Title = “请选择要查找的文件夹“ If .Show Then iPath = .SelectedItems(1) End If End With

If iPath = “False“ Or Len(iPath) = 0 Then Exit Sub

i = 1 Call GetFolderFile(iPath, i) MsgBox Timer - t MsgBox “文件名链接获取完毕。“, vbOKOnly, “提示“

End SubPrivate Sub GetFolderFile(ByVal nPath As String, ByRef iCount As Long)Dim iFileSys’Dim iFile As Files, gFile As File’Dim iFolder As Folder, sFolder As Folders, nFolder As Folder Set iFileSys = CreateObject(“Scripting.FileSystemObject“) Set iFolder = iFileSys.GetFolder(nPath) Set sFolder = iFolder.SubFolders Set iFile = iFolder.Files With ActiveSheet For Each gFile In iFile ’ .Hyperlinks.Add anchor:=.Cells(iCount, 1), Address:=gFile.path, TextToDisplay:=gFile.Name iCount = iCount + 1 Next End With

’递归遍历所有子文件夹 For Each nFolder In sFolder Call GetFolderFile(nFolder.path, iCount) NextEnd Sub 3、dir循环法Sub Test() ’使用双字典，旨在提高速度 Dim MyName, Dic, Did, i, t, F, TT, MyFileName ’On Error Resume Next Set objShell = CreateObject(“Shell.Application“) Set objFolder = objShell.BrowseForFolder(0, “选择文件夹“, 0, 0) If Not objFolder Is Nothing Then lj = objFolder.self.path & “\“ Set objFolder = Nothing Set objShell = Nothing t = Time Set Dic = CreateObject(“Scripting.Dictionary“) ’创建一个字典对象 Set Did = CreateObject(“Scripting.Dictionary“) Dic.Add (lj), ““ i = 0 Do While i 《 Dic.Count Ke = Dic.keys ’开始遍历字典 MyName = Dir(Ke(i), vbDirectory) ’查找目录 Do While MyName 《》 ““ If MyName 《》 “.“ And MyName 《》 “..“ Then If (GetAttr(Ke(i) & MyName) And vbDirectory) = vbDirectory Then ’如果是次级目录 Dic.Add (Ke(i) & MyName & “\“), ““ ’就往字典中添加这个次级目录名作为一个条目 End If End If MyName = Dir ’继续遍历寻找 Loop i = i + 1 Loop Did.Add (“文件清单“), ““ ’以查找D盘下所有EXCEL文件为例 For Each Ke In Dic.keys MyFileName = Dir(Ke & “*.xls“) Do While MyFileName 《》 ““ Did.Add (Ke & MyFileName), ““ MyFileName = Dir Loop Next For Each Sh In ThisWorkbook.Worksheets If Sh.Name = “XLS文件清单“ Then Sheets(“XLS文件清单“).Cells.Delete F = True Exit For Else F = False End If Next If Not F Then Sheets.Add.Name = “XLS文件清单“ End If Sheets(“XLS文件清单“)..Resize(Did.Count, 1) = WorksheetFunction.Transpose(Did.keys) TT = Time - t MsgBox Minute(TT) & “分“ & Second(TT) & “秒“End Sub

这个保证可以用：Sub t()Dim s As FileSearch ’定义一个文件搜索对象dim xlApp as Excel.ApplicationSet xlApp = New Excel.ApplicationSet s = xlApp.FileSearch....关键是要先创建一个excel程序的实例（在VBA中，这个实例即为当前excel程序Application，不需使用New语句创建）

sub DDD()I= i + 1P = “c:\users\“N = dir(p & *.xlsx“)If n like then gosub Cl ’如果文件名和A1给出的名字匹配，则进行处理On error goto exDoI= i + 1N = dirIf n like then gosub CLLoopEX:’此处放排序语句，我手机码字，不敲了。exit sub CL:Cells(i,2) = n ’B列输出文件名，并进行链接activesheet.hyperlinks.add anchor:= cells(i,2), address = p & nEnd sub

没错，看来是没有引用对象库，Microsoft Scripting Runtime。或者使这句Set fso = CreateObject(“Scripting.FileSystemObject“)有用，去掉这句：Dim fso As New FileSystemObject，并把类型Fold,File改成Object也是可以的。

filesearch只在03及以下版本的office才能用，高级的版本一般都用Dir函数遍历文件夹

所以我已经没法测试这段代码了，我只能写出来给你，对错无法保证

Sub Test()Dim i As IntegerDim strPath As StringstrPath = ThisWorkbook.PathWith Application.FileSearch.LookIn = strPath.SearchSubFolders = True.Filename = “*.*“If .Execute 》 0 ThenFor i = 1 To .FoundFiles.Countarr = Split(.FoundFiles(i), “\“)brr = Split(UBound(arr), “.“)Range(“A“ & i) = brr(LBound(brr))Next iEnd IfEnd WithEnd Sub

’就是把For循环里面替换一下

不可以。Office2007不支持FileSearch对象，在Office2003中使用了FileSearch对象遍历文件夹子文件夹搜索文件的代码不行了。