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

时间2024-02-11 08:30:03发布访客分类脚本浏览536

导读：收集整理的这篇文章主要介绍了vbs搜索文件名或者得到目录列表，觉得挺不错的，现在分享给大家，也给大家做个参考。 '把网上的一个小程序改得方便了点，这个搜索次效率很好。复制代码代码如下...

收集整理的这篇文章主要介绍了vbs搜索文件名或者得到目录列表，觉得挺不错的，现在分享给大家，也给大家做个参考。 '把网上的一个小程序改得方便了点，这个搜索次效率很好。
复制代码代码如下:
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

声明：本文内容由网友自发贡献，本站不承担相应法律责任。对本内容有异议或投诉，请联系2913721942#qq.com核实处理，我们将尽快回复您，谢谢合作！

若转载请注明出处： vbs搜索文件名或者得到目录列表
本文地址： https://pptw.com/jishu/609561.html

用vbs判断系统补丁的脚本用vbs写的短小精悍的字典生成器