Option Explicit

Dim objFSO
Dim intErrorLevel

Dim strPathToClear
Dim strFileMask


intErrorLevel = 0

With WScript.Arguments.Named
    If .Exists("PathToClear") And .Exists("FileMask") Then
        strPathToClear = .Item("PathToClear")
        strFileMask    = .Item("FileMask")
        
        WScript.Echo strPathToClear
        WScript.Echo strFileMask
        
        Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
        
        If objFSO.FolderExists(strPathToClear) Then
            ClearSubFolders objFSO.GetFolder(strPathToClear), strFileMask
        Else
            intErrorLevel = 2
        End If
        
        Set objFSO = Nothing
    Else
        intErrorLevel = 1
    End If
End With

WScript.Quit intErrorLevel
'=============================================================================

'=============================================================================
Sub ClearSubFolders(objFolder, strMask)
    Dim objSubFolder
    
    For Each objSubFolder In objFolder.SubFolders
        ClearSubFolders objSubFolder, strMask
    Next
    
    On Error Resume Next
    objFSO.DeleteFile objFSO.BuildPath(objFolder, strMask), True
    On Error Goto 0
    
    If (objFolder.Files.Count = 0) And (objFolder.SubFolders.Count = 0) Then
        If Not (objFolder.Path = strPathToClear) Then
            objFolder.Delete True
        End If
    End If
End Sub
'=============================================================================

Set objFSO = CreateObject("Scripting.FileSystemObject")
objStartFolder = "D:\Test\" 'папка которую очищаем
arrPath =array("d:\Test\","d:\Test\test1","d:\Test\test2", "d:\Test\test3") 'папки которые исключаем

Set objFolder = objFSO.GetFolder(objstartfolder)
Set colFiles = objFolder.Files
For Each objFile in colFiles
    If DateDiff("D", objFile.DateLastModified, Now) > 10 Then ' проверка файлов на старость
    Log (objFolder.Path & "\" & objFile.Name & " - " & objFile.DateLastModified)
    objFile.Attributes = 0
    objFile.Delete
    End If
Next

ShowSubfolders objFSO.GetFolder(objStartFolder)
Sub ShowSubFolders(Folder)
For Each Subfolder in Folder.SubFolders
    Set objFolder = objFSO.GetFolder(subfolder.Path)
p=false
i=lbound(arrpath)
WHILE (p=false) and (i<=ubound(arrpath))
    if (objfolder.path=arrpath(i) ) then
        p=true
    end if
    i=i+1
WEND
if (not p) then
'    Wscript.Echo objfolder.path & " - " & "udalat` mozna"
    ' 1) проверить файлы на старость
Set colFiles = objFolder.Files
For Each objFile in colFiles
    If DateDiff("D", objFile.DateLastModified, Now) > 10 Then ' проверка файлов на старость
    Log (objFolder.Path & "\" & objFile.Name & " - " & objFile.DateLastModified)
    objFile.Attributes = 0
    objFile.Delete
    End If
Next
    ' 2) проверить каталог на пустоту
If objFolder.Subfolders.Count > 0 then
ShowSubFolders SubFolder
End If 
    If subFolder.Files.Count > 0 AND subFolder.Subfolders.Count > 0 then
'    MsgBox "Directory " & subFolder & "- ne pusta."
    else
    Log(subFolder.Path & " - " & subFolder.Datecreated)
    objFSO.DeleteFolder(subFolder.Path)    
    End If
End If
Next
end sub

'функция для создания log-файла. он создается рядом со скриптом, имя - дата запуска скрипта.
Function Log(strLineToLog)
Const ForReading = 1, ForWriting = 2
Dim fso, f, FileLog

Set fso = CreateObject("Scripting.FileSystemObject")
FileLog = Left(WScript.ScriptName,(Len(WScript.ScriptName)-4)) & "_" & DatePart("yyyy",Date) & "_" & DatePart("m",Date) & "_" & DatePart("d",Date) & "." & "log"
Set f = fso.OpenTextFile(FileLog, 8, True)
f.Write strLineToLog & vbCrLf
f.Close
End Function