在主驱动器和所有驱动器的根目录中查找特定文件夹附加vbs

我想寻找一个特定的文件夹，可能在Windows 7机器的主驱动器的根目录或任何连接到它的USB驱动器的根目录。我宁愿用vbscript或者hta（而不是htaaccess）来使用vbscript。

恩。我需要find文件夹“xyz”。它可以在这里：C： xyz或D： xyz或者Z： xyz等。我不在乎它是否在这里：c： Users Joe xyz或者F： folder1 xyz。

如果search只集中在每个驱动器的根文件夹，我认为search会相当快。

HTA文件有什么要求？

实时捕获WScript.Shell的输出

HTA作为命令行GUI

Linux – 它有一个等效的？

如何使用VBS脚本从.ini文件中删除一行

在Windows 10的HTA（HTML应用程序）中可以使用x-ms-webview吗？

如何让HTA重新启动？

HTA追加表行

从HTA内启动batch file

在HTA文件中使用Javascript从Windowsregistry读取/写入

这个VBScript可以查找所有连接的驱动器中的文件夹，所以我添加一个等待栏让用户耐心等待，直到它完成工作

Option Explicit If AppPrevInstance() Then MsgBox "There is an existing proceeding !" & VbCrLF & CommandLineLike(WScript.ScriptName),VbExclamation,"There is an existing proceeding !" WScript.Quit Else Dim ws,fso,LogFile,Title,WaitingMsg,StartTime,DurationTime,FolderName,oExec,Temp Set ws = CreateObject("WScript.Shell") Set fso = CreateObject("Scripting.FileSystemObject") LogFile = Left(Wscript.ScriptFullName,InstrRev(Wscript.ScriptFullName,".")) & "log" if fso.FileExists(LogFile) Then fso.DeleteFile LogFile end if FolderName = InputBox("In the Box below type in the folder you are looking for","Find Folder by Hackoo 2015","folder") If FolderName = "" Then WScript.Quit Temp = ws.ExpandEnvironmentStrings("%Temp%") Title = "Looking for folder name "& DblQuote(FolderName) & " using Vbscript by Hackoo 2015" WaitingMsg = "Please wait... Searching for folder name : <font color=Yellow>"& DblQuote(FolderName) & "</font> is in progress..." Call CreateProgressBar(Title,WaitingMsg)'Creation of Waiting Bar Call LancerProgressBar() 'Launch of the Waiting Bar StartTime = Timer 'Start the Timer Counter Call FindFolder(FolderName) DurationTime = FormatNumber(Timer - StartTime,0) & " seconds." 'The duration of the script Call FermerProgressBar() 'Closing the Waiting Bar ws.Popup "The Searching of " & Dblquote(FolderName) & " is finished in " & DurationTime &" !","5","The Download of " & Dblquote(FolderName) & " is finished in " & DurationTime &" !",64 ws.run DblQuote(LogFile) ' To open the LogFile End If '************************************************************************************************************************* 'Search for Folders Sub FindFolder(Name) Dim strComputer,objWMIService,colFolders,objFolder strComputer = "." Set objWMIService = Getobject("winmgmts:" _ & "{impersonationLevel=impersonate}!\" & strComputer & "rootcimv2") Set colFolders = objWMIService.ExecQuery _ ("Select * from Win32_Directory where Name Like "& CommandLineLike(Name) &"") For Each objFolder in colFolders WriteLog objFolder.Name Next End sub '************************************************************************************************************************* Function CommandLineLike(Processpath) Processpath = Replace(Processpath,"","\") CommandLineLike = "'%" & Processpath & "%'" End Function '************************************************************************************************************************* Function AppPrevInstance() With Getobject("winmgmts:" & "{impersonationLevel=impersonate}!\.rootcimv2") With .ExecQuery("SELECT * FROM Win32_Process WHERE CommandLine LIKE " & CommandLineLike(WScript.ScriptFullName) & _ " AND CommandLine LIKE '%WScript%' OR CommandLine LIKE '%cscript%'") AppPrevInstance = (.Count > 1) End With End With End Function '***************************************************************************************************************************** Sub WriteLog(strText) Dim fs,ts Const ForAppending = 8 Set fs = CreateObject("Scripting.FileSystemObject") Set ts = fs.OpenTextFile(Left(Wscript.ScriptFullName,".")) & "log",ForAppending,True) ts.WriteLine strText ts.Close End Sub '******************************************************************************************************************************* Function DblQuote(Str) DblQuote = Chr(34) & Str & Chr(34) End Function '******************************************************************************************************************************* Sub CreateProgressBar(Title,WaitingMsg) Dim ws,f,f2,ts,ts2,Ligne,i,fread,Liretout,NbLignetotal,Temp,PathOutPutHTML,fhta,oExec Set ws = CreateObject("wscript.Shell") Set fso = CreateObject("Scripting.FileSystemObject") Temp = WS.ExpandEnvironmentStrings("%Temp%") PathOutPutHTML = Temp & "Barre.hta" Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True) fhta.WriteLine "<HTML>" fhta.WriteLine "<HEAD>" fhta.WriteLine "<Title> " & Title & "</Title>" fhta.WriteLine "<HTA:APPLICATION" fhta.WriteLine "ICON = ""magnify.exe"" " fhta.WriteLine "BORDER=""THIN"" " fhta.WriteLine "INNERBORDER=""NO"" " fhta.WriteLine "MAXIMIZEBUTTON=""NO"" " fhta.WriteLine "MINIMIZEBUTTON=""NO"" " fhta.WriteLine "SCROLL=""NO"" " fhta.WriteLine "SYSMENU=""NO"" " fhta.WriteLine "SELECTION=""NO"" " fhta.WriteLine "SINGLEINSTANCE=""YES"">" fhta.WriteLine "</HEAD>" fhta.WriteLine "<BODY text=""white""><CENTER>" fhta.WriteLine "<marquee DIRECTION=""LEFT"" SCROLLAMOUNT=""3"" BEHAVIOR=ALTERNATE><font face=""Comic sans MS"">" & WaitingMsg &"</font></marquee>" fhta.WriteLine "<img src=""data:image/gif;base64,R0lGODlhgAAPAPIAAP////INPvvI0/q1xPVLb/INPgAAAAAAACH/C05FVFNDQVBFMi4wAwEAAAAh/hpDcmVhdGVkIHdpdGggYWpheGxvYWQuaW5mbwAh+QQJCgAAACwAAAAAgAAPAAAD5wiyC/6sPRfFpPGqfKv2HTeBowiZGLORq1lJqfuW7Gud9YzLud3zQNVOGCO2jDZaEHZk+nRFJ7R5i1apSuQ0OZT+nleuNetdhrfob1kLXrvPariZLGfPuz66Hr8f8/9+gVh4YoOChYhpd4eKdgwDkJEDE5KRlJWTD5iZDpuXlZ+SoZaamKOQp5wAm56loK6isKSdprKotqqttK+7sb2zq6y8wcO6xL7HwMbLtb+3zrnNycKp1bjW0NjT0cXSzMLK3uLd5Mjf5uPo5eDa5+Hrz9vt6e/qosO/GvjJ+sj5F/sC+uMHcCCoBAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/4ixgeloM5erDHoNowBFFlJoxiiTFtqWwa/Jhx/86nKdc7vuJ6mxaABbUaUTvljBo++pxO5nFQFxMY1aW12pV+q9yYGk6NlW5bAPQuh7yl6Hg/TLeu2fssf7/19Zn9meYFpd3J1bnCMiY0RhYCSgoaIdoqDhxoFnJ0FFAOhogOgo6GlpqijqqKspw+mrw6xpLCxrrWzsZ6duL62qcCrwq3EsgC0v7rBy8Pnorycysi3xrnUzNjO2sXPx8nW07TRn+Hm3tfg6OLV6+fc37vR7Nnq8Ont9/Tb9v3yvPu66Xvnr16+gvwO3gKIIdszDw65Qdz2sCFFiRYFVmQFIAEBACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9J2qd1AoM9MYeF4KaWJKWmaJXxEyulI3zWa/39Xh6/vkT3q/DC/jibFjMSCM2hUybUwrdFa3Pqw+pdEVxU3AViKVqwz30cKzmQpZl8ZlNn9uzeLPH7eCrv2l1eXKDgXd6Gn5+goiEjYaFa4eOFopwZJh/cZCPkpGAnhoFo6QFE6WkEwOrrAOqrauvsLKttKy2sQ+wuQ67rrq7uAOoo6fEwsjAs8q1zLfOvAC+yb3B0MPHD8Sm19TS1tXL4c3jz+XR093X28ao3unnv/Hv4N/i9uT45vqr7NrZ89QFHMhPXkF69+AV9OeA4UGBDwkqnFiPYsJg7jBktMXhD165jvk+YvCoD+Q+kRwTAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJdCLnC/S+nsCFo1dq5zeRoFlJ1Du91hOq3b3qNo/5OdZPGDT1QrSZDLIcGp2o47MYheJuImmVer0lmRVlWNslYndm4Jmctba5gm9sPI+gp2v3fZuH78t4Xk0Kg3J+bH9vfYtqjWlIhZF0h3qIlpWYlJpYhp2DjI+BoxyOoqYaBamqbrorqq2urA8DtLUDE7a1uLm3s7y7ucC2wrq+wca2sbIOyrCuxLTQvQ680wDV0tnIxdS/27TND+HMsdrdx+fD39bY6+bX3um14wD09O3y0e77+ezx8OgAqutnr5w4g/3e4RPIjaG+hPwc+stV8NlBixAzSlT4bxqhx46/MF5MxUGkPA4BT15IyRDlwG0uG55MAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPECwbnu3gUKH1h2ZziNKVlJWDW9FvSuI/nkusPjrF0OaBIGfTna7GaTNTPGIvK4GUZRV1WV+ssKlE/G0hmDTqVbdPeMZWvX6XacAy6LwzAF092b9+GAVnxEcjx1emSIZop3g16Eb4J+kH+ShnuMeYeHgVyWn56hakmYm6WYnaOihaCqrh0FsbIFE7Oytba0D7m6DgO/wAMTwcDDxMIPx8i+x8bEzsHQwLy4ttWz17fJzdvP3dHfxeG/0uTjywDK1Lu52bHuvenczN704Pbi+Ob66MrlA+scBAQwcKC/c/8SIlzI71/BduysRcTGUF49i/cw5tO4jytjv3keH0oUCJHkSI8KG1Y8qLIlypMm312ASZCiNA0X8eHMqPNCTo07iyUAACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9F8mk8ap8hffaB3ZiWJKfmaJgJWHV5FqQK9uPuDr6yPeTniAIzBV/utktVmPCOE8GUTc9Ia0AYXWXPXaTuOhr4yRDzVIjVY3VsrnuK7ynbJ7rYlp+6/u2vXF+c2tyHnhoY4eKYYJ9gY+AkYSNAotllneMkJObf5ySIPHPe3ajiHqUfENvjqCDniIFsrMFE7Sztre1D7q7Dr0TA8LDA8HEwsbHycTLw83ID8fCwLy6ubfXtNm40dLPxd3K4czjzuXQDtID1L/W1djv2vHc6d7n4PXi+eT75v3oANSxAzCwoLt28P7hC2hP4beH974ZTEjwYEWKA9VBdBixLSNHhRPlIRR5kWTGhgz1peS30l9LgBojUhzpa56GmSVr9tOgcueFni15styZAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKsWIPiFwhia4kWWKrl5UGXFMFa/nJ0Da+r0rF9vAiQOH0DZTMeYKJ0y6O2JPApXRmxVe3VtSVSmRLzENWm7MM+65ra93dNXHgep71H0mSzdFec+b3SCgX91AnhTeXx6Y2aOhoRBkllwlICIi49liWmaapGhbKJuSZ+niqmeN6SWrYOvIAWztAUTtbS3uLYPu7wOvrq4EwPFxgPEx8XJyszHzsbQxcG9u8K117nVw9vYD8rL3+DSyOLN5s/oxtTA1t3a7dzx3vPwAODlDvjk/Orh+uDYARBI0F29WdkQ+st3b9zCfgDPRTxWUN5AgxctVqTXUDNix3QToz0cGXIaxo32UCo8+OujyJIM95F0+Y8mMov1NODMuPKdTo4hNXgMemGoS6HPEgA@R_404_6445@kECQoAAAAsAAAAAIAADwAAA/8ItAv+rD0XyaTxqnyr9pcgitpIhmaZouMGYq/LwbPMTJVE34/Z9j7BJCgE+obBnAWSwzWZMaUz+nQQkUfjyhrEmqTQGnins5XH5iU3u94Crtpfe4SuV9NT8R0Nn5/8RYbedHuFVId6iDyCcX9vXY2Bjz52imeGiZmLk259nHKfjkSVmpeWanhhm56skIyABbGybrozsrW2tA+5ug68uLbAsxMdxcYDxMfFycrMx87Gv7u5wrftwdfD2da+1A/Ky9/g0OEO4MjiytLd2Oza7twA6/Le8LHk6Obj6c/8xvjzAtaj147gO4Px5p3Dx9BfOQDnBBaUeJBiwoeLHeaDuE8uXzONFu9tE2mvF0KSJ00q7Mjxo8d+L/9pRKihILyaB29esEnzgkt/Gn7GDPosAQAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKv2HTcJJKmV5oUKJ7qBGPyKMzNVUkzjFoSPK9YjKHQQgsve7eeTKZs7ps4GpRqDSNcQu01Kazlwbxp+ksfipezY1V5X2ZI5XS1/5/j7l/12A/h/QXlOeoSGUYdWgXBtJXEpfXKFiJSKg5V2a1yRkIt+RJeWk6KJmZhogKmbniUFrq8FE7CvsrOxD7a3Drm1s72wv7QPA8TFAxPGxcjJx8PMvLi2wa7TugDQu9LRvtvAzsnL4N/G4cbY19rZ3Ore7MLu1N3v6OsAzM0O9+XK48Xn/+notRM4D2C9c/r6Edu3UOEAgwMhFgwomr48awnzMWOIzyfeM4ogD4aMOHJivYwexWlUmZJcPXcaXhKMORDmBZkyWa5suE8DuAQ@R_404_6445@kECQoAAAAsAAAAAIAADwAAA/8ItAv+rD0XyaTxqnyr9h03gZNgmtqJXqqwka8YM2NlQXYN2ze254/WyiF0BYU8nSyJ+zmXQB8UViwJrS2mlNacerlbSbg3E5fJ1WMLq9KeleB3N+6uR+XEq1rFPtmfdHd/X2aDcWl5a3t+go2AhY6EZIZmiACWRZSTkYGPm55wlXqJfIsmBaipbroqqaytqw+wsQ6zr623qrmusrATA8DBA7/CwMTFtr24yrrMvLW+zqi709K0AMkOxcYP28Pd29nY0dDL5c3nz+Pm6+jt6uLex8LzweL35O/V6fv61/js4m2rx01buHwA3SWEh7BhwHzywBUjOGBhP4v/HCrUyJAbXUSDEyXSY5dOA8l3Jt2VvHCypUoAIetpmJgAACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9F8mk8ap8q/YdN4Gj+AgoqqVqJWHkFrsW5Jbzbee8yaaTH4qGMxF3Rh0s2WMUnUioQygICo9LqYzJ1WK3XiX4Na5Nhdbfdy1mN8nuLlxMTbPi4be5/Jzr+3tfdSdXbYZ/UX5ygYeLdkCEao15jomMiFmKlFqDZz8FoKEFE6KhpKWjD6ipDqunpa+isaaqqLOgEwO6uwO5vLqutbDCssS0rbbGuMqsAMHIw9Dfdr+6vr/PzsnSx9rR3tPg3dnk2+LL1NXXvOXf7eHv4+bx6OfN1b0P+PTN/Lf98wK6ExgO37pd/pj9W6iwIbd6CdP9OmjtGzcNFsVhDHfxDELGjxw1Xpg4kheABAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKv2HTeBowiZjqCqG9malYS5sXXScYnvcP6swJqux2MMjTeiEjlbyl5MAHAlTEarzasv+8RCu9uvjTuWTgXedFhdBLfLbGf5jF7b30e3PA+/739ncVp4VnqDf2R8ioBTgoaPfYSJhZGIYhN0BZqbbrocm56fnQ+iow6loZ+pnKugpKKtmrGmAAO2twOor6q7rL2up7C/ssO0usG8yL7KwLW4tscA0dPCzMTWxtXS2tTJ297P0Nzj3t3L3+fmzerX6M3hueTp8uv07ezZ5fa08Piz/8UAYhPo7t6+CfDcafDGbOG5hhcYKoz4cGIrh80cPAOQAAAh+QQJCgAAACwAAAAAgAAPAAAD5wi0C/6sPRfJpPGqfKv2HTeBowiZGLORq1lJqfuW7Gud9YzLud3zQNVOGCO2jDZaEHZk+nRFJ7R5i1apSuQ0OZT+nleuNetdhrfob1kLXrvPariZLGfPuz66Hr8f8/9+gVh4YoOChYhpd4eKdgwFkJEFE5KRlJWTD5iZDpuXlZ+SoZaamKOQp5wAm56loK6isKSdprKotqqttK+7sb2zq6y8wcO6xL7HwMbLtb+3zrnNycKp1bjW0NjT0cXSzMLK3uLd5Mjf5uPo5eDa5+Hrz9vt6e/qosO/GvjJ+sj5F/sC+uMHcCCoBAA7AAAAAAAAAAAA"" />" fhta.WriteLine "</CENTER></BODY></HTML>" fhta.WriteLine "<SCRIPT LANGUAGE=""VBScript""> " fhta.WriteLine "Set ws = CreateObject(""wscript.Shell"")" fhta.WriteLine "Temp = WS.ExpandEnvironmentStrings(""%Temp%"")" fhta.WriteLine "Sub window_onload()" fhta.WriteLine " CenterWindow 490,110" fhta.WriteLine " Self.document.bgColor = ""DarkOrange"" " fhta.WriteLine " End Sub" fhta.WriteLine " Sub CenterWindow(x,y)" fhta.WriteLine " Dim iLeft,itop" fhta.WriteLine " window.resizeto x,y" fhta.WriteLine " iLeft = window.screen.availWidth/2 - x/2" fhta.WriteLine " itop = window.screen.availHeight/2 - y/2" fhta.WriteLine " window.moveto ileft,itop" fhta.WriteLine "End Sub" fhta.WriteLine "</script>" fhta.close End Sub '********************************************************************************************** Sub LancerProgressBar() Set oExec = Ws.Exec("mshta.exe " & Temp & "Barre.hta") End Sub '********************************************************************************************** Sub FermerProgressBar() oExec.Terminate End Sub '**********************************************************************************************

从帮助

所有可用驱动器的只读集合。

备注可移动介质驱动器不需要插入介质，以使其显示在Drives集合中。

以下示例说明如何使用Drives属性获取Drives集合并迭代集合：

Visual Basic脚本复制代码功能ShowDriveList

Dim fso,d,dc,s,n Set fso = CreateObject("Scripting.FileSystemObject") Set dc = fso.Drives For Each d in dc n = "" s = s & d.DriveLetter & " - " If d.DriveType = 3 Then n = d.ShareName ElseIf d.IsReady Then n = d.VolumeName Else n = "[Drive not ready]" End If s = s & n & "<BR>" Next ShowDriveList = s End Function

方法Drives集合没有方法。

属性计数属性| 项目属性

请参见参考驱动器对象驱动器属性文件对象文件集合文件夹对象文件夹集合

感谢@ user4532213让我朝着正确的方向前进。基本上，他给出的信息和代码列出了所有连接并准备在计算机上使用的驱动器。但是，它不会查找每个驱动器上的特定文件夹。所以，我采取了他提到的一些，

创建一个基本的HTA文件，以便于查看是否有人发现这个有用的。

增加了搜索所有驱动器上的特定文件夹的功能。

也意识到你可以使用这个在不同的驱动器上搜索相似的文件夹路径。

这个用法在HTA中有说明。

<html> <Head> <Title>Folder Finder.HTA</Title> <HTA:Application APPLICATIONNAME = " Folder Finder.HTA" Border = Thick ShowInTaskBar = No MaximizeButton = Yes MinimizeButton = Yes> <Script Language = VBScript> Sub Window_onLoad window.resizeto 400,300 self.Moveto 100,100 searchfoldername.Focus End Sub Sub FindFolder ' this will search all active drives for a folder or path matching the word inputed by user and list them in this HTA. ' Usage: type in a word to search or a path in the Box. ' Example: if you type in FOLDERONE it will search C:FOLDERONE and/or B:FOLDERONE (as long the drive is ready) etc. ' Example: if you type in FOLDEROnesUBFOLDERONE it will search for C:FOLDEROnesUBFOLDERONE and/or F:FOLDEROnesUBFOLDERONE Dim fso,n,searchfolder searchfolder = searchfoldername.value Set fso = CreateObject("Scripting.FileSystemObject") Set dc = fso.Drives i = 0 For Each d in dc s = d.DriveLetter & ":" Set oFSO=CreateObject("Scripting.FileSystemObject") If oFSO.FolderExists(s & searchfolder) Then s = s & searchfolder & "<BR>" ShowDriveList = s & ShowDriveList i = i + 1 End If Next document.getElementById("DataArea").innerHTML = i & " matches:" & "<BR>" & ShowDriveList End Sub </Script><Body>In the Box below type in the folder you are looking for<br></br> <input type="text" name="searchfoldername"> </input><br></br> <input type="button" button value="Search Folder" name="run_button" onClick="FindFolder"><br></br> <Span Id = "DataArea"> </Span></Body>

在主驱动器和所有驱动器的根目录中查找特定文件夹附加vbs

相关推荐