Option Explicit
Public fso As New FileSystemObject
Dim i As Long
Private Sub Command1_Click()
i = 0
Dim lstime
lstime = Timer
If Text2 <> "" Then
Text1 = ""
findFileNm Text2, Drive1.Drive
If Text1 = "" Then
MsgBox "没有要查找的数据"
Else
MsgBox "查找完毕,总共查到文件" & i & "个" & "用时" & Int((Timer - lstime) * 1000) & "毫秒"
End If
Else
Text2.SetFocus
MsgBox "请输入查找的文件！"
End If
End Sub
Function findFileNm(SeachFileName As String, ByVal DBpathFolder As String)
Dim objFile, objFolder
Set objFolder = fso.GetFolder(DBpathFolder)
For Each objFile In objFolder.Files
If UCase(Dir(objFile.Path, vbNormal)) Like "*" & UCase(SeachFileName) & "*" Then
i = i + 1
Text1 = Text1 & objFile.Path & vbNewLine
End If
Next
For Each objFolder In objFolder.SubFolders
findFileNm SeachFileName, objFolder '递归遍历整颗树
Next
End Function

Private Sub Form_Load()
Text1 = ""
Text2 = ""

End Sub