Set fso = CreateObject("Scripting.FileSystemObject")  
Set WSHShell = WScript.CreateObject("WScript.Shell")  
' * hier eigenen Bedürfnissen anpassen *  
strOrdnerliste = "C:\Dokumente und Einstellungen\pweberling\Desktop\Ordnerliste.txt"  
strAusschlussliste = "C:\Dokumente und Einstellungen\pweberling\Desktop\Ausschluss.txt"  
Aufheben = 0 'Anzahl der Tage  
' * Ende der Anpassungen *  
Sub DeleteInFolder(Ordner) 
ToKeepF = False 
For Each Ex In Exclude   
    If InStr(1, Ordner.Name, Trim(Ex), vbTextCompare) > 0 Then   
        ToKeepF = True   
        Exit For   
    End If   
Next   
If Not ToKeepF Then 
    Set Dateien = Ordner.Files  
    ' Alle Dateien in diesem Ordner abklappern  
    For Each Datei In Dateien  
        If Int(Datei.DateLastModified) <= (Heute - Aufheben) Then 
            ToKeep = False   
            For Each Ex In Exclude   
                If InStr(1, Datei.Name, Trim(Ex), vbTextCompare) > 0 Then  
                    ToKeep = True   
                    Exit For   
                End If   
            Next   
            If Not ToKeep Then 
                On Error Resume Next 
                Datei.Delete 
                If Err And Err <> 70 Then MsgBox "Unerwarteter Fehler (Code=" & Err & ")", vbCritical: WScript.Quit  
                On Error Goto 0  
            End If  
        End If  
    Next 
    'Unterordner abklappern, DeleteInFolder rekursiv aufrufen  
    For Each Unter In Ordner.SubFolders 
        DeleteInFolder(Unter) 
        If (Unter.SubFolders.Count + Unter.Files.Count) = 0 Then Unter.Delete 
    Next 
End If 
End Sub