Mit VBS Ordner und Dateien rekursiv löschen

[Eyeswide 10]

Hallo zusammen,

 

ich (als VBS-Noob) muss ein Script basteln, das Ordner und darin enthaltene Dateien Rekursiv löscht, wenn sie älter als 10 Tage sind.

 

Das meiste ist schon fertig, allerdings werden die Dateien in den Unterordnern nicht gelöscht. Unten habe ich das Script eingefügt, was mache ich falsch?

 

Bitte beachtet den Abschnitt zwischen 'Test und 'Testende.

 

Für Hilfe wäre ich dankbar.

 

 

Scritp:

 

OPTION EXPLICIT

Dim TRANSFER_PATH

Dim objFSO

Dim objFolder

Dim objFile

Dim objSubFolder

 

TRANSFER_PATH = "d:\temp"

 

Set objFSO = CreateObject("Scripting.FileSystemObject")

 

Set objFolder = objFSO.GetFolder(TRANSFER_PATH)

 

For Each objFile In objFolder.Files

If ((DateAdd("d", 10, objFile.DateLastModified) < Date) or (DateAdd("d", 10, objFile.DateLastAccessed) < Date)) Then

slog ( "Datei gelöscht: " & objFile.Path & "\" & objFile.Name & " - Letzter Zugriff war: " & objFile.DateLastAccessed & " - Letzte Änderung war: " & objFile.DateLastmodified)

objFile.Delete True

End If

Next

 

For Each objSubFolder In objFolder.SubFolders

'test

For Each objFile In objsubFolder.Files

If ((DateAdd("d", 20, objFile.DateCreated) < Date) or (DateAdd("d", 20, objFile.DateLastAccessed) < Date)) Then

slog ( "Datei gelöscht: " & objFile.Path & "\" & objFile.Name & " - Letzter Zugriff war: " & objFile.DateLastAccessed)

objFile.Delete True

End If

Next

'testende

If ((DateAdd("d", 10, objSubFolder.DateLastModified) < Date) or (DateAdd("d", 10, objSubFolder.DateLastAccessed) < Date)) Then

slog ( "Ordner gelöscht: " & objSobFolder.path & objSubFolder.Name & " - Letzter Zugriff war: " & objSubFolder.DateLastAccessed & " - Letzte Änderung war: " & objFile.DateLastmodified)

objSubFolder.Delete True

End If

Next

 

Set objSubFolder = Nothing

Set objFolder = Nothing

Set objFile = Nothing

Set objFSO = Nothing

 

WScript.Quit

 

Sub sLog (TextX)

Dim objfso, FileOut

Set objfso = CreateObject("Scripting.FileSystemObject")

Set FileOut = objfso.OpenTextFile (WScript.ScriptName & ".Log", 8, true)

FileOut.WriteLine (Now & " - " & TextX)

FileOut.Close

Set FileOut = Nothing

'Set fso = Nothing

End Sub

[Cybquest 36]

Hoi,

 

die Löschroutine sollte recursiv durch die Unterverzeichnisse gehen und löschen. Dein Script löscht nur die Dateien im aktuellen Ordner und in den Unterordnern 1.Ebene. Sollten sich darin weitere Unterordner befinden, wird nicht gelöscht.

 

Kannst Dir ja mal das Script, welches ich hier gepostet hab, anschauen:

http://www.mcseboard.de/windows-forum-scripting-71/ordner-batch-xx-tagen-loeschen-5-150449.html

 

Grüße, Frank

[Eyeswide 10]

He,

 

das sieht schon sehr geil aus!! Ich bastel mal damit rum, soweit es mein in Sachen VB beschränkter Verstand zulässt. ;-)

[Eyeswide 10]

Hi,

 

ich finde dein Script klasse. Das hat mir sicher Tage an Arbeit gespart! Allerdings hatte dein Script aufgrund des Alters der Ordner gelöscht, richtig? Das habe ich korrigiert nun löscht es nur Dateien, die Älter sind als n-Tage.

 

 

'---------------------------------------------------------

' KillOldFolders.vbs by FR

'---------------------------------------------------------

 

'-Konstanten----------------------------------------------

 

Const ForReading = 1, ForWriting = 2, ForAppending = 8

 

'-Variablen-----------------------------------------------

 

strRootFolder = "d:\temp"

strLogFile = "D:\Rekursiv_loeschen\log.txt"

strExcludeFile = "D:\Rekursiv_loeschen\KillfolderExclude.txt"

lngDays = 730

lngRetries = 3 'Anzahl Versuche, wenn Ordner-löschen fehlschlägt

lngRetSleepTime = 1000 'Wartezeit nach Fehlversuch in ms

 

'---------------------------------------------------------

 

'Wenn Statusmeldungen in DOS-Box gewünscht, Script mittels "cscript.exe KillOldFolders.vbs" starten!

If LCase (Right (WScript.FullName, 11)) <> "cscript.exe" Then boolcsript = False Else boolcscript=True

 

Set fso = CreateObject("Scripting.FileSystemObject")

Set ofolder = fso.GetFolder(strRootFolder)

Set flog = fso.OpenTextFile(strLogFile, ForAppending, True)

 

Writelog "---- Alte Ordner in " & strRootFolder & " werden gelöscht! - " & Now()

Writelog "Ausgeschlossene Verzeichnisse:"

 

Dim arrEx()

maxExcludes=0

If fso.FileExists(strExcludeFile) Then

Set fex = fso.OpenTextFile(strExcludeFile, ForReading)

Do While Not fex.AtEndOfStream

maxExcludes=maxExcludes+1

ReDim Preserve arrEx(maxExcludes)

arrEx(maxExcludes) = fex.readline()

Writelog arrEx(maxExcludes)

Loop

fex.close

End If

 

Writelog "----"

 

'Durchlaufe alle Unterverzeichnisse

For Each folder In ofolder.subfolders

KillfolderSub folder

Next

 

Writelog "---- Script beendet - " & Now()

if not boolcscript then MsgBox "Script beendet - " & Now()

 

'---------------------------------------------------------

'ENDE

'---------------------------------------------------------

 

Sub KillfolderSub(objFolder)

'On Error Resume Next

strFolder = objFolder.Path

' vardatecreated = objFolder.datecreated

 

'Wenn Ordner in "Exclude"-Liste steht, nicht löschen!

boolExclude = False

For i=1 To maxExcludes

if lcase(strFolder) = lcase(trim(arrEx(i))) then boolExclude = True

Next

 

If boolExclude Then

Writelog "Ordner " & strFolder & " incl. Unterordner nicht gelöscht (Exclude-Regel!)"

 

Else

 

'Durchlaufe alle Unterverzeichnisse

For Each subfolder In objFolder.subfolders

KillfolderSub subfolder

Next

 

'Wenn Ordner vor mehr als x Tagen erstellt wurde...

 

' WScript.Echo vardatecreated & " - "& Date & " - "& lngDays

' If vardatecreated < (Date - lngDays) Then

' WScript.Echo "alt löschen"

'Alle Dateien im Ordner löschen

For Each file In objFolder.Files

vardatecreated = file.DateLastModified

'Script.Echo file & " - "&vardatecreated & " - "& Date & " - "& lngDays

If vardatecreated < (Date - lngDays) Then

Err.Clear

strFile = file.Path

fso.DeleteFile strFile, True

If Err = 0 Then

Writelog "Datei " & strFile & " gelöscht"

Else

Writelog "Datei " & strFile & " konnte nicht gelöscht werden! - Fehler " & Err & " (" & Err.Description & ")"

End If

Else

Writelog "Datei " & strFile & " nicht gelöscht! - zu Neu" & vardatecreated

End If

Next

 

' End If

End If

 

 

 

On Error Goto 0

End Sub

 

'---------------------------------------------------------

 

Sub Writelog(strMessage)

 

flog.writeline strMessage

if boolcscript then WScript.echo strMessage

 

End Sub

 

[Eyeswide 10]

Hier der Rest, da die Antwort zu lang war:

 

Allerdings habe ich nun hier und da mal leere Ordner. Ich kämpfe gerade heftigst dagegen und hoffe, das mir der Gott des VB ne Eingebung schickt.

 

Für mich liest sich VB-Script wir Türkisch, mit der Hürde das noch jedes dritte Wort fehlt.

 

Falls also noch jemand eine Idee hat, wie ich nur die leeren Ordner entfernen kann, dann wäre ich wieder arg dankbar.

[Cybquest 36]

...Allerdings hatte dein Script aufgrund des Alters der Ordner gelöscht, richtig? Das habe ich korrigiert nun löscht es nur Dateien, die Älter sind als n-Tage.

Jou, das Script sollte ganze Ordner löschen. Ich dachte, als Basis für eigene Anpassungen konnte es ja dennoch herhalten :)

 

Da ja jetzt nur noch Dateien gelöscht werden, bleiben natürlich ggf. leere Ordner übrig. Um die zu löschen, müsste das Script überprüfen, ob ein Ordner leer ist (in der Art "objFolder.Files.Count = 0" oder so) und dann den Ordner löschen (wenn das denn gewünscht ist).

[Eyeswide 10]

So jetzt läufts! Danke nochmal an Alle!!!!!

 

'---------------------------------------------------------

' KillOldFolders.vbs by FR

'---------------------------------------------------------

 

'-Konstanten----------------------------------------------

 

Const ForReading = 1, ForWriting = 2, ForAppending = 8

 

'-Variablen-----------------------------------------------

 

strRootFolder = "d:\temp"

strLogFile = "D:\Rekursiv_loeschen\log.txt"

strExcludeFile = "D:\Rekursiv_loeschen\KillfolderExclude.txt"

lngDays = 365

lngRetries = 3 'Anzahl Versuche, wenn Ordner-löschen fehlschlägt

lngRetSleepTime = 1000 'Wartezeit nach Fehlversuch in ms

 

'---

 

'Wenn Statusmeldungen in DOS-Box gewünscht, Script mittels "cscript.exe KillOldFolders.vbs" starten!

If LCase (Right (WScript.FullName, 11)) <> "cscript.exe" Then boolcsript = False Else boolcscript=True

 

Set fso = CreateObject("Scripting.FileSystemObject")

Set ofolder = fso.GetFolder(strRootFolder)

Set flog = fso.OpenTextFile(strLogFile, ForAppending, True)

 

Writelog "---- Alte Ordner in " & strRootFolder & " werden gelöscht! - " & Now()

Writelog "Ausgeschlossene Verzeichnisse:"

 

Dim arrEx()

maxExcludes=0

If fso.FileExists(strExcludeFile) Then

Set fex = fso.OpenTextFile(strExcludeFile, ForReading)

Do While Not fex.AtEndOfStream

maxExcludes=maxExcludes+1

ReDim Preserve arrEx(maxExcludes)

arrEx(maxExcludes) = fex.readline()

Writelog arrEx(maxExcludes)

Loop

fex.close

End If

 

Writelog "----"

 

'Durchlaufe alle Unterverzeichnisse

For Each folder In ofolder.subfolders

KillfolderSub folder

Next

 

Writelog "---- Script beendet - " & Now()

if not boolcscript then MsgBox "Script beendet - " & Now()

 

'---

'ENDE

'---

 

Sub KillfolderSub(objFolder)

'On Error Resume Next

strFolder = objFolder.Path

' vardatecreated = objFolder.datecreated

 

'Wenn Ordner in "Exclude"-Liste steht, nicht löschen!

boolExclude = False

For i=1 To maxExcludes

if lcase(strFolder) = lcase(trim(arrEx(i))) then boolExclude = True

Next

 

If boolExclude Then

Writelog "Ordner " & strFolder & " incl. Unterordner nicht gelöscht (Exclude-Regel!)"

 

Else

 

'Durchlaufe alle Unterverzeichnisse

For Each subfolder In objFolder.subfolders

KillfolderSub subfolder

Next

 

'Wenn Ordner vor mehr als x Tagen erstellt wurde...

 

' WScript.Echo vardatecreated & " - "& Date & " - "& lngDays

' If vardatecreated < (Date - lngDays) Then

' WScript.Echo "alt löschen"

'Alle Dateien im Ordner löschen

For Each file In objFolder.Files

vardatecreated = file.DateLastModified

'Script.Echo file & " - "&vardatecreated & " - "& Date & " - "& lngDays

If vardatecreated < (Date - lngDays) Then

Err.Clear

strFile = file.Path

fso.DeleteFile strFile, True

If Err = 0 Then

Writelog "Datei " & strFile & " gelöscht"

Else

Writelog "Datei " & strFile & " konnte nicht gelöscht werden! - Fehler " & Err & " (" & Err.Description & ")"

End If

Else

Writelog "Datei " & strFile & " nicht gelöscht! - zu Neu" & vardatecreated

End If

Next

 

' End If

End If

 

 

 

 

On Error Goto 0

End Sub

 

 

'---

'Löschen leerer Ordner

'---

 

mko (strRootFolder)

 

Sub mko (sfolder)

Set fso = CreateObject("Scripting.FileSystemObject")

Set fsofolder = fso.GetFolder(sFolder)

For Each subfolder In fsofolder.SubFolders

 

mko(subfolder.Path)

 

Next

 

If fsofolder.Files.Count = 0 And fsofolder.SubFolders.Count = 0 Then

fsofolder.Delete vbTrue

 

End If

 

 

 

End Sub

 

 

'---

 

Sub Writelog(strMessage)

 

flog.writeline strMessage

if boolcscript then WScript.echo strMessage

 

End Sub

[Eyeswide 10]

Nochmal Many Thanks!!

 

Hat mir sehr viel Gewurschtel erspart!!

 

Ach ja "Delage32.exe" wäre zwar auch interessant gewesen, kann aber keine Verzeichnisse "excluden". Zumal der Kunde unbedingt VB wollte.

[BrinkMan 10]

Hi Eyeswide

 

Dein Script läuft ja soweit ganz gut und ich könnte es echt gut gebrauchen :)

 

Aber leider Löscht dein Script nicht die Dateien in "Root" Verzeichnis sind!

Also die Ordner/Subfolder/Dateien und die Exclude werden gelöscht bzw. ausgelassen.

 

Ist das so gewollt oder löscht der nur Ordner und Dateien in den Unterordner?

[pvlavh 10]

Hi All!

Hi Eyeswide!

 

Super gemachtes Script!

 

Nur kommt eine Fehlermeldung wenn eine Datei/Ordner im Zugriff (sprich geöffnet und daher gesperrt) ist.

Und danach suche ich schon länger, wie ein solcher Fehler umgangen werden kann und das Skript mit den restlichen Dateien weiter macht.

 

Kennt jemand eine Lösung? Oder hatte einen ähnlichen Fall?

 

grüße

Ralf