chrizz-at
Goto Top

Rekursives Löschscript! - Wo ist der Fehler?

Hallo liebe Gemeinde!

Ich habe hier ein Rekursives Löschscript selbst geschrieben, welches Dateien einzeln löscht (die die älter als 14 Tage sind).
Eine Error-Logdatei wird auch erstellt, funktioniert alles so wie es soll.

Nur steht aber auch in der Errorlog etwas was da nicht hingehört! siehe script code!
(Den Ordner habe ich gesperrt, das stimmt so aber das davor -> 2x "Grund: Objekt erforderlich" soll weg)
------- Errorlog -----------

Grund: Objekt erforderlich

Grund: Objekt erforderlich

05.12.2008 10:06:47:
Fehler beim Löschen von Ordner: Neuer Ordner (Pfad: C:\VTPFiles\Neuer Ordner)
Grund: Erlaubnis verweigert.


-------- SCRIPT ------------


Option Explicit
On Error Resume Next

' Konstanten definieren  
Const dir = "C:\VTPFiles"  
Const tage = "14"  
Const logdir = "C:\Logs"  


' Variablen Definieren  
Dim ErrorLog, ErrorFile, FSO

' Log Files öffnen  
Set FSO = CreateObject("Scripting.FileSystemObject")  

' Wenn der Logordner nicht existiert -> erstellen  
If not FSO.Folderexists(logdir) then
FSO.CreateFolder(logdir)
End if

Set ErrorFile = FSO.OpenTextFile(logdir & "\" & Date & "_error.log",8,true)  

' Datumsfunktion für Dateialter  
Dim alter
alter = FormatDateTime(Date - tage, 2)

Hauptscript dir, alter

private Sub Hauptscript(dir, alter)
	' Deklaration der Variablen  
	Dim FSO, Verzeichnis, UnterVerzeichnis, Datei, uDatei
	
	' Objekt erzeugen  
	Set FSO = CreateObject("Scripting.FileSystemObject")  
	
	' Referenz auf SourceOrdner  
	Set Verzeichnis = FSO.GetFolder(dir)
	
	' Files löschen (die älter als x tage sind)   
	On Error Resume Next
	For Each Datei in Verzeichnis.Files
		If Datediff("d", FormatDateTime(Datei.DateLastmodified, 2), alter) > 0 then  
		Datei.Delete
			If Err.Number <> 0 then
					ErrorFile.Writeline(Now() &":" & vbCrLf & "Fehler beim Löschen von Datei: " & Datei.Name & " (Pfad: " & Datei.Path & ")")  
					Errorfile.Writeline("Grund: " & Err.Description & vbCrLf)  
					Err.Clear
			End if
		End if
	Next
	
	' Alle Unterverzeichnisse  
	On Error Resume Next
	For Each UnterVerzeichnis in Verzeichnis.Subfolders
		' Erneuter Aufruf mit dem Unterverzeichnis  
		Hauptscript dir & "\" & UnterVerzeichnis.Name, alter  
			
		' Leere (Unter)Ordner löschen  
		If UnterVerzeichnis.Files.Count = 0 then
			UnterVerzeichnis.Delete
				If Err.Number <> 0 then
					ErrorFile.Writeline(Now() &":" & vbCrLf & "Fehler beim Löschen von Ordner: " & UnterVerzeichnis.Name & " (Pfad: " & Unterverzeichnis.Path & ")")  
					Errorfile.Writeline("Grund: " & Err.Description & vbCrLf)  
					Err.Clear
				End if
		End if
	Next
End Sub
Errorfile.Close
(Für verbesserungsvorschläge des scriptes bin ich offen face-smile)
Danke für eure Hilfe!


lg chris

Content-Key: 103370

Url: https://administrator.de/contentid/103370

Ausgedruckt am: 29.03.2024 um 07:03 Uhr