Jump to content

Mit VBS Ordner und Dateien rekursiv löschen


Der letzte Beitrag zu diesem Thema ist mehr als 180 Tage alt. Bitte erstelle einen neuen Beitrag zu Deiner Anfrage!

Empfohlene Beiträge

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

Link zu diesem Kommentar

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

Link zu diesem Kommentar

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

 

Link zu diesem Kommentar

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.

Link zu diesem Kommentar
...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).

Link zu diesem Kommentar

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

Link zu diesem Kommentar
  • 8 Monate später...
  • 2 Jahre später...

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

Link zu diesem Kommentar
Der letzte Beitrag zu diesem Thema ist mehr als 180 Tage alt. Bitte erstelle einen neuen Beitrag zu Deiner Anfrage!

Schreibe einen Kommentar

Du kannst jetzt antworten und Dich später registrieren. Falls Du bereits ein Mitglied bist, logge Dich jetzt ein.

Gast
Auf dieses Thema antworten...

×   Du hast formatierten Text eingefügt.   Formatierung jetzt entfernen

  Only 75 emoji are allowed.

×   Dein Link wurde automatisch eingebettet.   Einbetten rückgängig machen und als Link darstellen

×   Dein vorheriger Inhalt wurde wiederhergestellt.   Editor-Fenster leeren

×   Du kannst Bilder nicht direkt einfügen. Lade Bilder hoch oder lade sie von einer URL.

×
×
  • Neu erstellen...