'v3.7***************************************************** 

' File:   VerzeichnisAltDelete.vbs 

' Autor:  dieseyer@gmx.de  

'         dieseyer.de 

' 

' Löscht alle Verzeichnisse, die ab einem bestimmten Datum 

'********************************************************* 

 

Option Explicit 

 

Dim Pfad, Alter 

 

Pfad = "d:\setup" 

Pfad = "."          ' Verzeichnis, in dem sich das Skript befindet, Skript wird also auch gelöscht 

Pfad = "c:\temp" 

 

Alter = 365         ' Verzeichnisse, die vor xxx Tagen angelegt wurden 

 

MsgBox AlteVerzLoeschen (Pfad, Alter )    'Function Aufruf  und   Ergebnisanzeige 

       AlteVerzLoeschen "c:\temp", 100    'Function Aufruf  OHNE  Ergebnisanzeige 

'                                                          ~~~~~~  

 

WScript.Quit 

 

 

'********************************************************* 

Function AlteVerzLoeschen  (Pfad, Alter) ' Anfang 

'********************************************************* 

Dim fso, Txt, i, oSubFolder 

 

Alter   = FormatDateTime( now() - Alter ,2)  

 

Set fso = WScript.CreateObject("Scripting.FileSystemObject") 

 

if not fso.FolderExists( Pfad ) then 

  MsgBox UCase(Pfad) & "   existiert nicht!", , WScript.ScriptName 

  Exit Function 

End If 

 

AlteVerzLoeschen = "In   " & UCase( Pfad ) & "   wurden vor dem   " & Alter & "   angelegte Verzeichnisse gelöscht." & vbCRLF & vbCRLF 

 

Set oSubFolder = fso.GetFolder( Pfad ).SubFolders  

  For Each i In oSubFolder  

 

  if DateDiff("d" , i.DateLastModified, Alter) > 0 then ' vor dem Alter geänderte Verzeichnisse 

 

      Txt = i.Path       ' nach dem Löschen von i.Path ist auch i.Path gelöscht 

      AlteVerzLoeschen = AlteVerzLoeschen & i.Name & "  " & vbTab & FormatDateTime( i.DateLastModified ,2)  

 

  On Error Resume Next 

 

    fso.DeleteFolder Txt, True 

 

  On Error GoTo 0 

 

    If not fso.FolderExists( Txt ) Then  

      AlteVerzLoeschen = AlteVerzLoeschen & vbCRLF 

    Else 

      AlteVerzLoeschen = AlteVerzLoeschen & " nicht gelöscht." & vbCRLF 

    End if 

 

  End If 

 

Next 

 

Set fso        = nothing  

Set oSubFolder = nothing 

 

End Function ' AlteVerzLoeschen