'••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
' Назначение: Рекурсивное удаление файлов в папках по списку имён
' Параметры:
' 1)          "<путь к списку обрабатываемых папок>"
' 2)          "<путь к списку имён удаляемых файлов>"
' 3)          "<путь к файлу отчёта>" (необязательный)

' Автор:      Flasher ©
'••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••

Title = "   Рекурсивное удаление файлов"
Set FSO = CreateObject("Scripting.FileSystemObject")

' Объявление и проверка наличия параметров
With WScript.Arguments
  If .Count < 2 Then
    MsgBox  "Укажите хотя бы 2 параметра!", 4144, Title : Quit
  End If : FoldList = .Item(0) : FileList = .Item(1)
  If .Count = 3 Then LogFile = .Item(2) : LF = 1 End If 
End With

' Проверка наличия файлов-списков
Test(FoldList)(FileList)
Function Test(FF)
  If FF <> "" And Not FSO.FileExists(FF) Then
    MsgBox "Файл " & FF & " отсутствует!", 4144, Space(10) & Title : Quit
  End If : Set Test = GetRef("Test")
End Function

' Проверка содержимого файлов-списков
Inside FoldList, Fd : Inside FileList, Fl
Sub Inside(FList, Spl)
 On Error Resume Next
   With FSO.OpenTextFile(FList) : L = .ReadLine : T = .ReadAll : End With
   If Err.Number = 0 Then
     Spl = Split(T, vbNewLine) : If Ubound(Spl) = 0 Then Msg FList
   ElseIf Trim(L) <> "" Then Spl = Array(L) Else Msg FList : End If
 On Error GoTo 0
End Sub
Sub Msg(FLs)
MsgBox "Список " & FLs & " пуст!", 4144, Space(15) & Title : Quit : End Sub

' Создание коллекции из списка файлов
Set Dict = CreateObject("Scripting.Dictionary")
For Each F in Fl : Dict.Add Trim(F), "" : Next
If LF Then Set SpLog = FSO.OpenTextFile(LogFile, 8, True)

' Проход по директориям из списка с выполнением процедуры удаления
For Each F in Fd
  F = Trim(F)
  If F <> "" Then
    If FSO.FolderExists(F) Then ForFolder FSO.GetFolder(F)  
  End If
Next : If LF Then SpLog.Close

' Процедуры рекурсивного удаление файлов с именами из списка
Sub ForFolder(Folder)
  Dim N
  For Each N In Folder.SubFolders : ForFolder N : Next
  For Each N In Folder.Files      : ForFile   N : Next
End Sub
Sub ForFile(File)
  If Dict.Exists(FSO.GetFileName(File)) Then
    LogF = File : FSO.DeleteFile File, 0
    If LF And Not FSO.fileExists(LogF) Then _
    SpLog.WriteLine Now & " удалён файл " & LogF
  End If 
End Sub

' Вывод всплывающего сообщения об окончании работы и выход
CreateObject("WScript.Shell").Popup "Удаление файлов завершено!", 1.5,_
"    " & Title, 64 : Quit
Sub Quit : Set FSO = Nothing : Set Dict = Nothing : WScript.Quit : End Sub

strPath = File.Path
objFSO.DeleteFile strPath, 1            'удаляем
LogStream.WriteLine "Был удален файл: " & strPath & ": " & Now()

papka = "c:\00000\"
sps ="c:\00000\456.txt" 'файл со списком файлов

On Error Resume Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
LogPath = objFSO.GetParentFolderName(WScript.ScriptFullName)
Set LogStream = objFSO.OpenTextFile(LogPath & "\DelLog.log", 8, True)
LogStream.WriteLine "Начало удаления: " & Now()

'читаем файл со списком файлов
Set File2 = objFSO.GetFile(sps)
Set TextStream = File2.OpenAsTextStream(1)
Str = vbNullString


While Not TextStream.AtEndOfStream
   Str = TextStream.ReadLine()

RecursiveFolderScan papka
Wend
LogStream.WriteLine "Конец удаления: " & Now()
LogStream.WriteLine
LogStream.Close
TextStream.Close
Msgbox "ВСЕ!"


Sub RecursiveFolderScan(FolderPath)
    'Получаем объектную модель текущего каталога
    Set Folder = objFSO.GetFolder(FolderPath)
 
    'Перебираем все файлы в текущем каталоге
    For Each File in Folder.Files
         If LCase(File.Name)=LCase(Str) Then    'и если имя файла совпадает со строкой из файла
                LogStream.WriteLine "Был удален файл: " & File.Path & ": " & Now()
        objFSO.DeleteFile File.Path, 1            'удаляем

    End if
    Next
 
    'Перебираем все подкаталоги в каталоге
    For Each SubFolder in Folder.SubFolders
        RecursiveFolderScan(SubFolder.Path)
    Next
End Sub

    objFSO.DeleteFile File.Path, 1            'удаляем
          LogStream.WriteLine "Был удален файл: " & File.Path & ": " & Now()