'把网上的一个小程序改得方便了点,这个搜索次效率很好。 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
=======================================================================
附件:关于打开目录的方面:
Private Const CSIDL_DESKTOP = &H0 ' |