Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  

Показать сообщение отдельно

Старожил


Сообщения: 175
Благодарности: 119

Профиль | Отправить PM | Цитировать


Цитата 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
Это сообщение посчитали полезным следующие участники:

Отправлено: 17:28, 18-01-2011 | #12