源码网商城,靠谱的源码在线交易网站 我的订单 购物车 帮助

源码网商城

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

  • 时间:2021-07-20 06:55 编辑: 来源: 阅读:
  • 扫一扫,手机访问
摘要:vbs搜索文件名或者得到目录列表
'把网上的一个小程序改得方便了点,这个搜索次效率很好。
[u]复制代码[/u] 代码如下:
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 ' <desktop>  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 ' <user name>\Favorites  Private Const CSIDL_STARTUP = &H7 ' Start Menu\Programs\Startup  Private Const CSIDL_RECENT = &H8 ' <user name>\Recent  Private Const CSIDL_SENDTO = &H9 ' <user name>\SendTo  Private Const CSIDL_BITBUCKET = &HA ' <desktop>\Recycle Bin  Private Const CSIDL_STARTMENU = &HB ' <user name>\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_DESKTOPDIRECTORY = &H10 ' <user name>\Desktop  Private Const CSIDL_DRIVES = &H11 ' My Computer  Private Const CSIDL_NETWORK = &H12 ' Network Neighborhood (My Network Places)  Private Const CSIDL_NETHOOD = &H13 ' <user name>\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_DESKTOPDIRECTORY = &H19 ' All Users\Desktop  Private Const CSIDL_APPDATA = &H1A ' <user name>\Application Data  Private Const CSIDL_PRINTHOOD = &H1B ' <user name>\PrintHood  Private Const CSIDL_LOCAL_APPDATA = &H1C ' <user name>\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 ' <user name>\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
  • 全部评论(0)
联系客服
客服电话:
400-000-3129
微信版

扫一扫进微信版
返回顶部