[SendMessage]

Хм, не думал, что их несколько. Ну тогда так можно:

Код:

Option Explicit
 
Const ROOT_FOLDER = "D:\"
Const SEARCH_FOLDER = "hl"

Dim strDelFolder
Dim objFSO
Dim RetVal
Dim arrDelFolders
Dim i
  
Set objFSO = CreateObject("Scripting.FileSystemObject")

GetFolders ROOT_FOLDER

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
    For Each objSubFolder In objFSO.GetFolder(strFolderName).SubFolders 
      If LCase(objSubFolder.Name) = LCase(SEARCH_FOLDER) Then
        strDelFolder = strDelFolder & strFolderName & vbNewline
      Else 
        GetFolders objSubFolder.Path
      End If  
    Next    
End Sub