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("請輸入搜索關鍵字點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 "結果保存在"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