'把網(wǎng)上的一個小程序改得方便了點，這個搜索次效率很好。
on error resume next
Dim keyWord, DirTotal, TimeSpend, FileTotal, Fso, outFile, txtResult, txtPath, sPath
Const MY_COMPUTER = &H11&
Const WINDOW_HANDLE = 0
Const OPTIONS = 0
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(My_Computer)
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path

Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, "選擇你要搜索的文件夾:", OPTIONS, strPath)
If objFolder Is Nothing Then
msgbox "您沒有選擇任何有效目錄!"
wscript.quit
else
Set objFolderItem = objFolder.Self
sPath = objFolderItem.Path
txtpath=sPath
Set Fso = wscript.CreateObject("scripting.filesystemobject")

FileTotal = 0
DirTotal = 0

'sPath = left(Wscript.ScriptFullName,len(Wscript.ScriptFullName)-len(Wscript.ScriptName))
'txtPath = trim(inputbox("你選的目錄是"&sPath,"文件搜索",sPath))

keyWord = LCase(inputbox("請輸入搜索關(guān)鍵字點Cancel的話會得到目錄列表:","文件搜索","mp3"))

set outFile = Fso.createtextfile(sPath & "\SearchResult.txt")

outFile.writeline "開始搜索..."
outFile.writeline "起啟目錄:" & txtPath
TimeSpend = Timer

myFind txtPath

TimeSpend = round(Timer - TimeSpend,2)

txtResult = "搜索完成!" & vbCrLf & "共找到文件:" & FileTotal & "個." & vbCrLf & "共搜索目錄:" & DirTotal & "個." & vbCrLf & "用時:" & TimeSpend & "秒."
outFile.write txtResult
msgbox txtResult &"結(jié)果保存在"&sPath &"\SearchResult.txt"

outFile.close
set outFile = nothing
set Fso = nothing

Sub myFind(ByVal thePath)

Dim fso, myFolder, myFile, curFolder
Set fso = wscript.CreateObject("scripting.filesystemobject")
Set curFolders = fso.getfolder(thePath)
DirTotal = DirTotal   1
If curFolders.Files.Count > 0 Then
For Each myFile In curFolders.Files
If InStr(1, LCase(myFile.Name), keyWord) > 0 Then
outFile.WriteLine FormatPath(thePath) & "\" & myFile.Name
FileTotal = FileTotal   1
End If
Next
End If

If curFolders.subfolders.Count > 0 Then
For Each myFolder In curFolders.subfolders
myFind FormatPath(thePath) & "\" & myFolder.Name
Next
End If

End Sub

Function FormatPath(ByVal thePath)

thePath = Trim(thePath)
FormatPath = thePath
If Right(thePath, 1) = "\" Then FormatPath = Mid(thePath, 1, Len(thePath) - 1)

End Function

End if

=======================================================================

附件：關(guān)于打開目錄的方面：

Private Const CSIDL_DESKTOP = &H0 '