我只知道文件名，在sheet1.cells(1,1）中（比如2012年6月紧急通知.doc，想在cells(1,2)返回他的完整路径（文件可能在c盘也可能在d盘、e盘下的子文件夹或其他文件夹里，需要全电脑搜索）
做一个宏
第一列都是文件名，第二列要自动搜索后返回他的完整路径，大侠先做一个吧
'查找电脑文件，包括同名不同盘，不同目录
Private Sub CommandButton1_Click()
Dim i&, irow&, k&, j&, fso As Object, drs As Object, dr As Object
irow = Range("A65536").End(xlUp).Row
For i = 1 To irow
Set fso = CreateObject("Scripting.FileSystemObject")
Set drs = fso.Drives
On Error GoTo err1
k = 2
For Each dr In drs
If IsNumeric(dr.totalsize) And dr.isready Then
With Application.FileSearch
.NewSearch
.LookIn = dr.Path
.SearchSubFolders = True
.Filename = Range("a" & i)
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
For j = 1 To .FoundFiles.Count
Cells(i, k) = .FoundFiles(j)
k = k + 1
Next j
End If
End With
End If
Next
Next i
err1:
End Sub追问
Private Sub CommandButton1_Click()
Dim i&, irow&, k&, j&, fso As Object, drs As Object, dr As Object
irow = Range("A65536").End(xlUp).Row
For i = 1 To irow
Set fso = CreateObject("Scripting.FileSystemObject")
Set drs = fso.Drives
On Error GoTo err1
k = 2
For Each dr In drs
If IsNumeric(dr.totalsize) And dr.isready Then
With Application.FileSearch
.NewSearch
.LookIn = dr.Path
.SearchSubFolders = True
.Filename = Range("a" & i)
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
For j = 1 To .FoundFiles.Count
Cells(i, k) = .FoundFiles(j)
k = k + 1
Next j
End If
End With
End If
Next
Next i
err1:
End Sub追问
怎么运行
追答有邮箱吗，我发给你
追问2389751136@qq.com
多谢大侠
FileSearch 这个2007不支持
温馨提示：答案为网友推荐，仅供参考
第1个回答 2012-08-18
是搜索文件名？？是全部匹配还是部分匹配。。。全部匹配。估计也要10分钟。。。追问
搜索文件名返回路径，或者部分匹配也行，你有什么就给什么吧，谢谢
