Цитата T3D:
как искать на нескольких дисках? »
|
Сделал с обработкой ошибок. На случай, если при обращении к папке доступ будет закрыт или еще что:
Код:
Option Explicit
Const SEARCH_FOLDER = "hl"
Dim strDelFolder
Dim objFSO
Dim RetVal
Dim arrDelFolders
Dim i
Dim arrDriveItem
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each arrDriveItem In objFSO.Drives
If arrDriveItem.DriveType = 2 Then GetFolders arrDriveItem.Path & "\"
Next
If Len(strDelFolder) Then
arrDelFolders = Split(strDelFolder, vbNewline)
For i = 0 To UBound(arrDelFolders) - 1
If objFSO.FolderExists(arrDelFolders(i)) Then
RetVal = MsgBox("Вы хотите удалить папку """ & arrDelFolders(i) & """," & vbNewLine & _
"в которой находится искомая папка """& SEARCH_FOLDER & """?", 33, "Удаление папки")
If RetVal = 1 Then objFSO.DeleteFolder arrDelFolders(i), True
End If
Next
Else
MsgBox "Папка """ & SEARCH_FOLDER & """ не найдена.", 64, "Удаление папки"
End If
Set objFSO = Nothing
WScript.Quit 0
Sub GetFolders(strFolderName)
Dim objSubFolder
On Error Resume Next
For Each objSubFolder In objFSO.GetFolder(strFolderName).SubFolders
If LCase(objSubFolder.Name) = LCase(SEARCH_FOLDER) Then
If Err.Number = 0 Then
strDelFolder = strDelFolder & strFolderName & vbNewLine
Else
MsgBox "Ошибка при обращении к """ & strFolderName & """."
Err.Clear
End If
Else
GetFolders objSubFolder.Path
End If
Next
End Sub
Если достаточно перебрать конкретные диски:
Код:
For Each arrDriveItem In Array("C:\", "D:\", "F:\")
GetFolders arrDriveItem
Next