[T3D]

Можете подсказать как искать на нескольких дисках?

[SendMessage]

как искать на нескольких дисках? »

Сделал с обработкой ошибок. На случай, если при обращении к папке доступ будет закрыт или еще что:

Код:

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

[T3D]

SendMessage, и снова вы спасли меня. Я пару часов сидел пытался сделать массив, но не получалась.

Надеюсь, начальство ничего больше не придумает.