我只知道文件名,在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分钟。。。追问
搜索文件名返回路径,或者部分匹配也行,你有什么就给什么吧,谢谢