Alte Ordnerinhalte automatisch löschen

''--------------------------------------------------------------------------------------  
'' Dateien anhand des Alters löschen :::::::::::::::::::::::::::::::::::::::::::::::::::  
''--------------------------------------------------------------------------------------  
'' Erwartet 2 Parameter mit den Schaltern -f und -t direkt gefolgt von den Werten ::::::  
'' -f Startverzeichnis für die rekursive Suche :::::::::::::::::::::::::::::::::::::::::  
'' -t Alter der Dateien in Tagen :::::::::::::::::::::::::::::::::::::::::::::::::::::::  
''--------------------------------------------------------------------------------------  
Option Explicit 
'On Error Resume Next   

Const blnOverWrite = TRUE
Const blnNoOverWrite = FALSE
Const blnWait4Return = TRUE
Const blnNoWait4Return = FALSE

Dim WshNetwork
Dim WshShell
Dim objFSO
Dim objFolder
Dim objSubFld
Dim objLog
Dim objArgs
Dim f1
Dim f2
Dim colFiles
Dim arrDate
Dim strScriptName
Dim strCompName
Dim strExt
Dim strStart				'Startverzeichnis für die rekursive Suche  
Dim strMSG
Dim strRelPath
Dim strLog
Dim strLogFile
Dim strTemp
Dim intTTL					'Alter der Dateien in Tagen  
Dim i
Dim j

Set WshShell = WScript.CreateObject("WScript.Shell")  
Set WshNetwork = Wscript.CreateObject("WScript.Network")  
Set objFSO = CreateObject("Scripting.FileSystemObject")   
Set objArgs = WScript.Arguments

strScriptName = Wscript.ScriptName
strCompName = WshNetwork.ComputerName
strExt = ".log"  
strLog = "\\<server>\>share>\"  
j = 1
strMSG = "Scriptname: " & vbTab & strScriptName & vbCrLf & "gestartet auf: " & vbTab & _  
	strCompName & vbCrLf & "gestartet am: " & vbTab & WeekdayName(Weekday(Date)) & ", " & _  
	Now & vbCrLf

If objArgs.Count = 2 Then
	Dim Item
	For Each Item in objArgs
		Select Case Left(Item, 2)
		Case "-f"  
			strStart = CStr(Right(Item, Len(Item) - 2))
			strMSG = strMSG & "Startverzeichnis: " & vbTab & strStart & vbCrLf  
		Case "-t"  
			intTTL = CInt(Right(Item, Len(Item) - 2))
			strMsg = strMSG & "Kriterium: " & vbTab & intTTL & " Tage" & vbCrLf  
		End Select
	Next

strMsg = strMsg & "_--_--_--_--_--_--_--_--_--_--_--_--_--_--_--_--_--_--_--_--_" & vbCrLf  

	If ChkFolder(strStart) Then
			Main(strStart)
	Else
		MsgBox "Argument """ & strStart & """ ungültig - Abbruch"  
		strMsg = strMsg & "Argument """ & strStart & """ ungültig - Abbruch" & vbCrLf  
		WriteLog strLog, strMSG
	End If
Else	
	strMsg = strMsg & "Falsche Anzahl an Argumenten (" & objArgs.Count & _  
		" von 2) - Abbruch" & vbCrLf  
	WriteLog strLog, strMSG
	MsgBox "Falsche Anzahl an Argumenten (" & objArgs.Count & " von 2) - Abbruch"  
End If

Sub Main(Startfolder)
If ChkFolder(strLog) = TRUE Then 'das Ziel für das Logfile  
	strMSG = strMSG & vbCrLf & "#" & vbTab & "RelativePath" & vbTab & "//" & vbTab & _  
		"DateCreated" & vbTab & "//" & vbTab & "LastModified" & vbTab & "//" & vbTab & _  
		"LastAccessed" & vbTab & "//" & vbTab & "Action"  
	j = 0
	ListFolder StartFolder
	strMSG = strMSG & vbCrLf & vbCrLf & _
		"_--_--_--_--_--_--_--_--_--_--_--_--_--_--_--_--_--_--_--_--_" & vbCrLf & _  
		j & " Dateien gelöscht" & vbCrLf & "beendet am: " & vbTab & _  
		WeekdayName(Weekday(Date)) & ", " & Now  
	WriteLog strLog, strMSG
End If
End Sub

Function ChkFolder(Path2Folder)
ChkFolder = FALSE
If objFSO.FolderExists(Path2Folder) Then
	ChkFolder = TRUE
End If
End Function

Function ChkFile(Path2File)
ChkFile = FALSE
If objFSO.FileExists(Path2File) Then
	ChkFile = TRUE
End If
End Function

Private Sub ListFolder(StartFolder)
Set objFolder = objFSO.GetFolder(StartFolder)
ListFiles objFolder
Set objSubFld = objFolder.SubFolders
For Each f2 in objSubFld 
	ListFolder f2 
Next
End Sub

Private Sub CopyFlsFld(Src, Dst, Overwrite)
Dim objSrc
Set objSrc = objFSO.GetFile(Src)
objSrc.Copy Dst, Overwrite
End Sub

Private Sub ListFiles(Start) 
Set colFiles = Start.Files
For Each f1 in colFiles
	If DateDiff("d", f1.DateCreated, Date) > intTTL Then  
		strRelPath = Right(objFSO.GetAbsolutePathName(f1), _
		Len(objFSO.GetAbsolutePathName(f1)) - Len(strStart))
		strMSG = strMSG & vbCrLf & j + 1 & vbTab & strRelPath & vbTab & "//" & vbTab & f1.DateCreated & _  
		vbTab & "//" & vbTab &  f1.DateLastModified  & vbTab & "//" & vbTab & _  
		f1.DateLastAccessed & vbTab & "//" & vbTab & "gelöscht"  
		objFSO.DeleteFile(f1)
		j = j + 1
	End If 
Next
End Sub 

Private Sub WriteLog(strLog, Report)
Set objLog = objFSO.CreateTextFile(GenerateFileName, blnNoOverWrite) 
objLog.Write Report
objLog.Close
End Sub

Function GenerateFileName()
arrDate = Split(FormatDateTime(Date, 2),".")  
strLogFile = strCompName & "_" & strScriptName & "_" & arrDate(2) & "." & arrDate(1) & "." & arrDate(0)  
strTemp = strLogFile
For i = 1 To 999
	If objFSO.FileExists(strLog & strLogFile & strExt) Then
		strLogFile = strTemp & "_" & String(3 - Len(i), "0") & i  
	Else
		GenerateFileName = strLog & strLogFile & strExt
  	Exit Function
	End If
Next
End Function

Set WshNetwork = Nothing
Set WshShell = Nothing
Set objFSO = Nothing
Set objFolder = Nothing
Set objSubFld = Nothing
Set objLog = Nothing
Set objArgs = Nothing
f1 = ""  
f2 = ""  
colFiles = ""  
arrDate = ""  
strScriptName = ""  
strCompName = ""  
strExt = ""  
strStart = ""  
strMSG = ""  
strRelPath = ""  
strLog = ""  
strLogFile = ""  
strTemp = ""  
intTTL = ""  
i  = ""  
j = ""  
Wscript.Quit