Dateien erst nach Abgleich mit Archiv löschen

Tach zusammen,

ich habe folgendes geniale Teil:

Set fso = CreateObject("Scripting.FileSystemObject")  
Set WSHShell = WScript.CreateObject("WScript.Shell")  
On Error Resume Next

'* hier eigenen Bedürfnissen anpassen *  

strOrdnerliste = "D:\Sicherung\Ordnerliste.txt"  
strAusschlussliste = "D:\Sicherung\Ausschluss.txt"  

Set objOrdnerliste = fso.OpenTextFile(strOrdnerliste, 1)
Verzeichnis = Split(objOrdnerliste.ReadAll, vbCrLF)
objOrdnerliste.Close

Set objAusschlussliste = fso.OpenTextFile(strAusschlussliste, 1)
If Not objAusschlussliste.AtEndOfStream Then 'falls nicht schon am Dateiende (= Datei ist leer) ...  
	Exclude = objAusschlussliste.ReadLine ' ... erste Zeile lesen und speichern ...  
Else
	Exclude = "" '... ansonsten gibt es keine Ausnahmen beim Löschen.  
End If

objAusschlussliste.Close

Aufheben = 1 'Anzahl der Tage  

' * Ende der Anpassungen *  

Heute = Date()
For n = 0 To UBound(Verzeichnis) 
	Set Ordner = fso.GetFolder(Verzeichnis(n))
	DeleteInFolder(Ordner)
Next

Sub DeleteInFolder(Ordner)
Set Dateien = Ordner.Files
' Alle Dateien in diesem Ordner abklappern  
For Each Datei In Dateien
	If Datei.DateLastModified < (Heute - Aufheben) Then
		Ext = Mid(Datei.Name, InStrRev(Datei.Name, "."))  
		If InStr(Exclude, Ext) = 0 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 Sub

hier: Alte Dateien nach x Tagen löschen und dabei bestimmte Dateiendungen ausschließen gefunden.

Kann man dem Tool noch erklären, dass es die alten Dateien ERST GENAU DANN löschen darf, wenn diese Dateien an einem anderen Ort (Archiv) vorhanden sind ????

Grueße vom Dorf ...

[Edit Biber] Als formatiert. [/Edit]

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 83887

Url: https://administrator.de/forum/dateien-erst-nach-abgleich-mit-archiv-loeschen-83887.html

Ausgedruckt am: 01.05.2025 um 05:05 Uhr

5 Kommentare

Neuester Kommentar

Hallo Stylewalker!

Kann man dem Tool noch erklären, dass es die alten Dateien ERST GENAU DANN löschen darf, wenn diese Dateien an einem anderen Ort (Archiv) vorhanden sind ?

Wenn Du dem Tool (oder wenigstens mir) sagen kannst, wo (gleiche Ordnerstruktur?) / wie (nur Namensgleichheit oder zB auch gleiches Änderungsdatum?) im "Archiv" nach der jeweiligen Datei zu suchen ist ...

Abgesehen davon würde sich dafür aber vielleicht eine "Verschiebe"-Lösung (in einem der öfter hier im Forum vorkommenden Beiträge zum Thema "alte Dateien" oder "alte Ordner" - wie etwa "Robocopy - Alte Ordner verschieben" - solltest Du fündig werden) eher anbieten.

Grüße
bastla

Morgen bastla,

zur Geschichte:

Im Moment zieh ich mit Robocopy die Dateien, die älter sind als xx Tage aus dem zu durchsuchenden Verzeichnis raus, überprüfe mit einem "if exist", ob die Datei im Archiv (auf einer zweiten Festplatte, in gleicher Ordnerstruktur) existiert, bevor diese gelöscht wird. Da die reine Überprüfung, ob die Datei "halt da" ist nicht so prall ist, wäre darüberhinaus eine Überprüfung auf z.B. gleiche Dateigröße/gleiches Änderungsdatum quzasi ideal

Gruß

Style

Hallo Stylewalker!

... überprüfe mit einem "if exist" ...

"fc /b" wäre noch genauer als der Vergleich hinsichtlich Größe / Datum ...

Grüße
bastla

Hast natürlich recht, funktioniert

.... aber nur mal interessehalber: wie würde das mit VB aussehen???

Hallo Stylewalker!

Da VBS keinen zu "fc" vergleichbaren Befehl kennt, könntest Du, wie oben schon angemerkt, Dateidatum und zB auch -größe vergleichen ("File.DateLastModified", "File.Size")oder trotzdem "fc" verwenden (ungetestete Skizze):

If Not fc("D:\Datei1.doc", "E:\Datei1.doc") Then  
	'Dateien sind unterschiedlich ...  
End If

Function fc(File1, File2)
Set objShell = CreateObject("WScript.Shell")  
Set objExec = objShell.Exec("fc /b " & Chr(34) & File1 & Chr(34) & " " & Chr(34) & File2 & Chr(34))  
strResults = LCase(objExec.StdOut.ReadAll)
If InStr(strResults, "fc: keine unterschiede gefunden") Then  
	fc = True
Else
	fc = False
End If
End Function