'查找电脑文件,包括同名不同盘,不同目录
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
是搜索文件名??是全部匹配还是部分匹配。。。全部匹配。估计也要10分钟。。。