'Variablen
Quelle       = "C:\test"
Ziel         = "d:\test"
Zeitraum     = 1 'Anzahl in Tagen
DateiAnzahl     = 0
 
'Beginn
 
Pruefen_und_Verschieben Quelle
Msgbox "Es wurden " & DateiAnzahl & " Dateien verschoben."
WScript.Quit
'Ende
 
'Funktionen
 
Function Pruefen_und_Verschieben(Pfad)
 
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set Ordner = fso.GetFolder(Pfad)
  Set Dateien = Ordner.Files
 
  For Each Datei In Dateien
    If Datei.Left(Datei.Name, 17) = "firewallname-2005" Then
      If DateDiff("d", Datei.DateLastModified, Now) > Zeitraum Then
        Zielordner = Replace(Datei.ParentFolder, Left(Datei.ParentFolder, 1), _
          Left(Ziel, 1))
        If Not fso.FolderExists(Zielordner) Then ZielOrdner_anlegen Zielordner
        fso.MoveFile Datei, Zielordner & "\": DateiAnzahl = DateiAnzahl + 1
      End If
    End If
  Next Datei
 
  ' Unterordner auch durchgehen
  Set Subfolders = Ordner.Subfolders
  For Each SubFolder In Subfolders
    Call Pruefen_und_Verschieben(SubFolder)
  Next SubFolder
 
End Function
 
Function ZielOrdner_anlegen(Zielordner)
     Set fso = CreateObject("Scripting.FileSystemObject")
     Dim OrdnerArray
     OrdnerArray = Split(Zielordner,"\",-1,1)
     Startpfad = OrdnerArray(0) & "\" & OrdnerArray(1)
     For i = 1 to UBound(OrdnerArray)
         If NOT fso.FolderExists(Startpfad) Then fso.CreateFolder(Startpfad)
         If i < UBound(OrdnerArray) Then Startpfad = Startpfad & "\" & _
           OrdnerArray(i + 1)
     Next
End Function