vbs搜索文件名或者得到目錄列表

字號:

'把網(wǎng)上的一個(gè)小程序改得方便了點(diǎn),這個(gè)搜索次效率很好。
    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)鍵字點(diǎn)Cancel的話會(huì)得到目錄列表:","文件搜索","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 & "個(gè)." & vbCrLf & "共搜索目錄:" & DirTotal & "個(gè)." & vbCrLf & "用時(shí):" & 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_DESK = &H0 '
    Private Const CSIDL_INTERNET = &H1 ' Internet Explorer (icon on desktop)
    Private Const CSIDL_PROGRAMS = &H2 ' Start Menu\Programs
    Private Const CSIDL_CONTROLS = &H3 ' My Computer\Control Panel
    Private Const CSIDL_PRINTERS = &H4 ' My Computer\Printers
    Private Const CSIDL_PERSONAL = &H5 ' My Documents
    Private Const CSIDL_FAVORITES = &H6 ' \Favorites
    Private Const CSIDL_STARTUP = &H7 ' Start Menu\Programs\Startup
    Private Const CSIDL_RECENT = &H8 ' \Recent
    Private Const CSIDL_SENDTO = &H9 ' \SendTo
    Private Const CSIDL_BITBUCKET = &HA ' \Recycle Bin
    Private Const CSIDL_STARTMENU = &HB ' \Start Menu
    Private Const CSIDL_MYDOCUMENTS = &HC ' logical "My Documents" desktop icon
    Private Const CSIDL_MYMUSIC = &HD ' "My Music" folder
    Private Const CSIDL_MYVIDEO = &HE ' "My Videos" folder
    Private Const CSIDL_DESKDIRECTORY = &H10 ' \Desktop
    Private Const CSIDL_DRIVES = &H11 ' My Computer
    Private Const CSIDL_NETWORK = &H12 ' Network Neighborhood (My Network Places)
    Private Const CSIDL_NETHOOD = &H13 ' \nethood
    Private Const CSIDL_FONTS = &H14 ' windows\fonts
    Private Const CSIDL_TEMPLATES = &H15
    Private Const CSIDL_COMMON_STARTMENU = &H16 ' All Users\Start Menu
    Private Const CSIDL_COMMON_PROGRAMS = &H17 ' All Users\Start Menu\Programs
    Private Const CSIDL_COMMON_STARTUP = &H18 ' All Users\Startup
    Private Const CSIDL_COMMON_DESKDIRECTORY = &H19 ' All Users\Desktop
    Private Const CSIDL_APPDATA = &H1A ' \Application Data
    Private Const CSIDL_PRINTHOOD = &H1B ' \PrintHood
    Private Const CSIDL_LOCAL_APPDATA = &H1C ' \Local Settings\Applicaiton Data (non roaming)
    Private Const CSIDL_ALTSTARTUP = &H1D ' non localized startup
    Private Const CSIDL_COMMON_ALTSTARTUP = &H1E ' non localized common startup
    Private Const CSIDL_COMMON_FAVORITES = &H1F
    Private Const CSIDL_INTERNET_CACHE = &H20 'TEMPORARY INTERNET FILES
    Private Const CSIDL_COOKIES = &H21
    Private Const CSIDL_HISTORY = &H22
    Private Const CSIDL_COMMON_APPDATA = &H23 ' All Users\Application Data
    Private Const CSIDL_WINDOWS = &H24 ' GetWindowsDirectory()
    Private Const CSIDL_SYSTEM = &H25 ' GetSystemDirectory()
    Private Const CSIDL_PROGRAM_FILES = &H26 ' C:\Program Files
    Private Const CSIDL_MYPICTURES = &H27 ' C:\Program Files\My Pictures
    Private Const CSIDL_PROFILE = &H28 ' USERPROFILE
    Private Const CSIDL_SYSTEMX86 = &H29 ' x86 system directory on RISC
    Private Const CSIDL_PROGRAM_FILESX86 = &H2A ' x86 C:\Program Files on RISC
    Private Const CSIDL_PROGRAM_FILES_COMMON = &H2B ' C:\Program Files\Common
    Private Const CSIDL_PROGRAM_FILES_COMMONX86 = &H2C ' x86 Program Files\Common on RISC
    Private Const CSIDL_COMMON_TEMPLATES = &H2D ' All Users\Templates_
    Private Const CSIDL_COMMON_DOCUMENTS = &H2E ' All Users\Documents
    Private Const CSIDL_COMMON_ADMINTOOLS = &H2F ' All Users\Start Menu\Programs\Administrative Tools
    Private Const CSIDL_ADMINTOOLS = &H30 ' \Start Menu\Programs\Administrative Tools
    Private Const CSIDL_CONNECTIONS = &H31 ' Network and Dial-up Connections
    Private Const CSIDL_COMMON_MUSIC = &H35 ' All Users\My Music
    Private Const CSIDL_COMMON_PICTURES = &H36 ' All Users\My Pictures
    Private Const CSIDL_COMMON_VIDEO = &H37 ' All Users\My Video
    Private Const CSIDL_RESOURCES = &H38 ' Resource Direcotry
    Private Const CSIDL_RESOURCES_LOCALIZED = &H39 ' Localized Resource Direcotry
    Private Const CSIDL_COMMON_OEM_LINKS = &H3A ' Links to All Users OEM specific apps
    Private Const CSIDL_CDBURN_AREA = &H3B ' USERPROFILE\Local Settings\Application Data\Microsoft\CD Burning
    Private Const CSIDL_COMPUTERSNEARME = &H3D ' Computers Near Me (computered from Workgroup membership)
    Private Const CSIDL_FLAG_CREATE = &H8000 ' combine with CSIDL_ value to force folder creation in SHGetFolderPath()
    Private Const CSIDL_FLAG_DONT_VERIFY = &H4000 ' combine with CSIDL_ value to return an unverified folder path
    Private Const CSIDL_FLAG_NO_ALIAS = &H1000 ' combine with CSIDL_ value to insure non-alias versions of the pidl
    Private Const CSIDL_FLAG_PER_USER_INIT = &H800 ' combine with CSIDL_ value to indicate per-user init (eg. upgrade)
    Private Const CSIDL_FLAG_MASK = &HFF00 ' mask for all possible flag values
    =============================================================================