'======================================================================
' Удаление в указанной папке файлов с N-дневным сроком,
'   где N-число, которое можно задать вторым параметром
'   или через константу cTerm в скрипте.
' Также можно определить признак сканирования вложенных папок
'   с помощью третьего параметра (0\1) или константы
'   cRecursion (False\True).
' Если в качестве первого параметра указан файл, то он
'   рассматривается, как файл-список папок для обработки.
'
' Параметры вызова:
' {папка} [{срок} [{признак сканирования вложеннных папок}]]
' {файл-список} [{срок} [{признак сканирования вложеннных папок}]]
'
' Скрипт можно применять к текущей (под курсором) папке в TC:
' %P%N [{срок} [{признак сканирования вложеннных папок}]]
' Скрипт можно применять к выделенным папкам в TC:
' %L [{срок} [{признак сканирования вложеннных папок}]]
'======================================================================

Option Explicit
'======== Изменяемые параметры ========================================
Const cTerm      = 30    'Срок файлов в днях
Const cRecursion = True  'Признак сканирования вложенных папок
'======================================================================

Dim Term, Recursion, Mess, FSO, FF, ListFlag, F, Errors

SetMess
Set FSO     = CreateObject("Scripting.FileSystemObject")
Set Errors  = CreateObject("Scripting.Dictionary")
CheckParam

If ListFlag Then
  For Each F In Split(FSO.OpenTextFile(FF).ReadAll, vbNewLine)
    Main F
  Next
Else
  Main FF
End If

If Errors.Count > 0 Then
  MessBox JoinErr(Errors), 2
Else
  MessBox Mess(7), 3
End If
Quit

Sub Main(pF)
  Dim oF, lF
  If Not FSO.FolderExists(pF) Then
    Errors.Add pF, pF & " - " & Mess(5)
    Exit Sub
  End If
  Set oF = FSO.GetFolder(pF)
  For Each lF In oF.Files
    On Error Resume Next
    If (Int(Date - lF.DateLastModified) + 1) = Term Then
      FSO.DeleteFile lF, True
    End If
    If Err.Number > 0 Then
      If Not Errors.Exists(lF) Then
        Errors.Add lF, lF & " - " & Mess(6) & Err.Description
      End If
    End If
    On Error GoTo 0
  Next
  If Recursion Then
    For Each lF In oF.SubFolders
      Main lF
    Next
  End If
  Set oF = Nothing
  Set lF = Nothing
End Sub

Sub CheckParam
  If WScript.Arguments.Count = 0 Then
    MessBox Mess(1), 1
    Quit
  End If
  FF = WScript.Arguments(0)
  ListFlag = FSO.FileExists(FF)
  If (Not ListFlag) And (Not FSO.FolderExists(FF)) Then
    MessBox Mess(2), 1
    Quit
  End If
  If WScript.Arguments.Count > 1 Then
    Term = WScript.Arguments(1)
    If Term = "" Then
      Term = cTerm
    Else
      If Not IsNumeric(Term) Then
        MessBox Mess(3), 1
        Quit
      End If
      Term = CInt(Term)
    End If
  Else
    Term = cTerm
  End If
  If WScript.Arguments.Count > 2 Then
    Recursion = WScript.Arguments(2)
    If Not ((Recursion = 0) Or (Recursion = 1)) Then
      MessBox Mess(4), 1
      Quit
    End If
    Recursion = (Recursion = 1)
  Else
    Recursion = cRecursion
  End If
End Sub

Sub SetMess
  Set Mess = CreateObject("Scripting.Dictionary")
  Mess.Add 0,  "Удаление файлов по сроку"
  Mess.Add 1,  "Не указаны параметры!"
  Mess.Add 2,  "Первый параметр не является папкой или файлом-списком!"
  Mess.Add 3,  "Второй параметр не является числом!"
  Mess.Add 4,  "Третий параметр должен принимать значения 0 или 1!"
  Mess.Add 5,  "Не является папкой!"
  Mess.Add 6,  "Не удалось выполнить удаление: "
  Mess.Add 7,  "Операция завершена."
  Mess.Add 8,  "Операция завершена с ошибками." & vbNewLine
End Sub

Function JoinErr(pDic)
  Dim lKey
  For Each lKey In pDic
    JoinErr = JoinErr & vbNewLine & vbNewLine & pDic(lKey)
  Next
  JoinErr = Mess(8) & JoinErr
End Function

Function MessBox(pMess, pMode)
  Dim lIcon
  Select Case pMode
    Case 1 lIcon = vbCritical    + vbOKOnly
    Case 2 lIcon = vbExclamation + vbOKOnly
    Case 3 lIcon = vbInformation + vbOKOnly
  End Select
  MessBox = MsgBox(pMess, lIcon, Mess(0))
End Function

Sub Quit
  Set Errors = Nothing
  Set Mess   = Nothing
  Set FSO    = Nothing
  Wscript.Quit
End Sub