Ordner mit Batch nach xx Tagen löschen.

[elta33 10]

Ich muss ja gestehen dass ich VBS nur oberflächlich überblicke, denke nicht dass ich einen solchen Fehler finden kann, sofern überhaupt noch existend.

 

Kann allerdings nachsehen, ob ich alles gemäß deiner Anleitung gemacht habe ;-)

[Cybquest 36]

Hier nochmal der kpl., bei mir funktinonierende, Code:

'---------------------------------------------------------
' KillOldFolders.vbs by FR
'---------------------------------------------------------

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

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

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

strRootFolder = "J:\DIV\VB"
strLogFile = "J:\DIV\KillfolderLog.txt"
strExcludeFile = "J:\DIV\KillfolderExclude.txt"
lngDays = 14

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

'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

 'Durchlaufe alle Unterverzeichnisse
 for each subfolder in objfolder.subfolders
   KillFolderSub subfolder
 next

 strFolder = objFolder.Path

 'Wenn Ordner in "Exclude"-Liste steht, nicht löschen!
 boolExclude = false
 For i=1 to maxExcludes
   if strFolder = trim(arrEx(i)) then boolExclude = true
 next

 if boolExclude then
   writelog "Ordner " & strFolder & " nicht gelöscht (Exclude-Regel!)"

 else

   'Wenn Ordner vor mehr als x Tagen erstellt wurde...
   if objFolder.datecreated < (Date - lngDays) then

     'Alle Dateien im Ordner löschen
     for each file in objfolder.Files
       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
     next

     'Ordner löschen
     Err.Clear
     fso.DeleteFolder(strFolder)
     if Err = 0 then
       writelog "Ordner " & strFolder & " gelöscht"
     else
       writelog "Ordner " & strFolder & " konnte nicht gelöscht werden! - Fehler " & Err & " (" & Err.Description & ")"
     end if
   else
     writelog "Ordner " & strFolder & " nicht gelöscht (jünger als " & lngDays & " Tage! Datecreated: " & objFolder.datecreated
   end if
 end if

on error goto 0
End Sub

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

Sub Writelog(strMessage)

 flog.writeline strMessage
 if boolcscript then wscript.echo strMessage

End Sub

[elta33 10]

Auf jeden Fall funktioniert dein Script!

 

Beim ersten Versuch ging es allerdings nicht, deshalb habe ich mit anderen Verzeichnissen getestet. Ich vermute einen Fehler, kann aber kein Muster sehen.

 

habe zum Testen folgende Folder excluded:

(Die Anzeige ist aus CMD kopiert)

 

---- Alte Ordner in c:\del\ werden gelöscht! - 09.06.2009 16:37:14

Ausgeschlossene Verzeichnisse:

C:\del\net

C:\del\DVDtest

C:\del\pstools

C:\del\regshot

C:\del\runas

C:\del\stromberg

C:\del\temp

 

Folgende Folder sind erhalten geblieben, dahinter stand auch sehr schön (Exclude Regel!)

 

net

DVDtest

runas

temp

 

Die Anderen wurden trotz excluded gelöscht, darunter auch die, die ich bei den ersten Versuchen hatte. Deshalb immer negativ.

 

Kannst du dir das erklären?

[Cybquest 36]

OK, ich schau's mir in einer ruhigen Minute an.

Solche "Nebenher-Scriptereien", die hier von mir eigentlich nur als Anregung eingestellt werden, bergen halt immer die Gefahr, nicht vollständig ausgetestet zu sein ;)

 

Ich vermute, es liegt an der Rekursion. Da das Script ja immer erst in die tiefste Ebene geht und von dort rückwärts löscht, muss ich vermutlich beim Exclude nacharbeiten...

[elta33 10]

Ist nett von dir, Danke!

Das ist völlig OK, dass nicht alles beim ersten Mal funktioniert, zumal du das nebenbei machst.

 

Du warst schon eine sehr große Hilfe, von daher meinen Respekt für die schnelle Arbeit.

 

Es ist schon paradox, dass es keine Software zu geben scheint, die genau diese Bedürfnisse abdeckt, obwohl es in der Administration wirklich nützlich ist.

Sämtliche mit bekannten Löschtools orientieren sich ausschließlich am Dateidatum, so auch das beliebte Delage32, dafür kann es aber sonst alles was ich brauch.

[Cybquest 36]

Nächster Versuch:

'---------------------------------------------------------
' KillOldFolders.vbs by FR
'---------------------------------------------------------

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

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

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

strRootFolder = "J:\DIV\VB"
strLogFile = "J:\DIV\KillfolderLog.txt"
strExcludeFile = "J:\DIV\KillfolderExclude.txt"
lngDays = 14

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

'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 strFolder = 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...
   if vardatecreated < (Date - lngDays) then

     'Alle Dateien im Ordner löschen
     for each file in objfolder.Files
       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
     next

     'Ordner löschen
     Err.Clear
     fso.DeleteFolder(strFolder)
     if Err = 0 then
       writelog "Ordner " & strFolder & " gelöscht"
     else
       writelog "Ordner " & strFolder & " konnte nicht gelöscht werden! - Fehler " & Err & " (" & Err.Description & ")"
     end if
   else
     writelog "Ordner " & strFolder & " nicht gelöscht (jünger als " & lngDays & " Tage! Datecreated: " & vardatecreated & ")"
   end if
 end if

on error goto 0
End Sub

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

Sub Writelog(strMessage)

 flog.writeline strMessage
 if boolcscript then wscript.echo strMessage

End Sub

 

Habs hier mal durch mein Homeverzeichnis durchlaufen lassen und nur das in die Exclude reingeschrieben, was wirklich noch da bleiben soll... hat funktioniert :)

(...und hab somit gleich mal bei mir aufgeräumt *gg*)

 

Zur Info:

Ich hab die Abfrage, ob ein Verzeichnis in der Excludeliste steht, vor den rekursiven Aufruf gesetzt. Viel mehr hab ich nicht gemacht.

[elta33 10]

Hi Cybquest,

 

vielen Dank nochmal an der Stelle, es funktioniert!

Das hat es allerdings auch beim letzten Mal schon, ich habe den Fehler bei mir gefunden. In der KillfolderExclude.txt muss exakte Groß und Kleinschreibung beachtet werden, daran hatte ich nicht gedacht. Ich schreibe meist in solchen Dateien alles klein, aber es gab auch Folder mit Großbuchstaben vorne. Auch innerhalb des Namens muss das beachtet werden habe ich bemerkt.

 

Ein kleiner Fehler war aber auch in deinem letzten Script von gestern:

 

Datei C:\del\runas\runasspc\sample.txt gelöscht

Ordner C:\del\runas\runasspc gelöscht

Ordner C:\del\runas nicht gelöscht (Exclude-Regel!)

 

Wie du siehst, wird alles unter "C:\del\runas" gelöscht, nur der Ordner selber nicht, weil ja Excluded. Komischer Weise betraf das nur diesen einen Ordner?!

 

Bei dem Script von heute ist das Problem beseitigt:

 

Ordner C:\del\runas incl. Unterordner nicht gelöscht (Exclude-Regel!)

 

Gute Arbeit!

Wenn ich nicht noch unendecke Fehler finde, ist das für mich OK so.

Mit der Beachtung der Schreibweise kann ich absolut leben!

 

Grüße

[Cybquest 36]

Um Groß-/Kleinschreibung zu ignorieren könnte man die Vergleichs-Zeile z.B. so erweitern:

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

[elta33 10]

Mal eben schnell die Zeile geändert und schon wird Schreibweise ignoriert.

Super Sache!

 

Ich sollte mich mal mit dem Thema besser beschäftigen, da ist viel möglich ;-)

[Cybquest 36]

Jetzt hast ja'n bissle Code zum analysieren ;)

 

...allerdings: Wenn schon neu mit Coding beschäftigen, dann evtl. gleich Powershell! Ich werde für mich zur Übung (da ich bisher auch noch nicht viel mit PS gemacht hab) das Ganze auch mal auf Powershell portieren. Stell ich dann, wenn's denn soweit ist, auch rein :)

[elta33 10]

Habe das Script jetzt über eine große Datenmenge (Backup) laufen lassen, es sollte alles älter 180 Tage gelöscht werden. Es wird auch jede Menge gelöscht, aber irgendwann fällt er auf die Nase mit folgender Meldung:

 

T:\Del_old_folders.vbs(96, 7) Laufzeitfehler in Microsof

t VBScript: Erlaubnis verweigert.

 

Rechte habe ich geprüft und zur Sicherheit neu vererbt.

Hast du ne Ahnung, wie ich rausfinde, über welchen Ordner er stolpert?

[Cybquest 36]

Ja, hab zum testen ne Zeile auskommentiert, die aber drin bleiben muss!

Da muss das Anführungsstrichchen vorne weg:

on error resume next

 

Danach sollte das Script durchlaufen und bei einem Ordner die "Zugriff verweigert"-Meldung ins Log schreiben.

Warum der Zugriff verweigert wird... gilt's dann rauszufinden. Vermutlich wird versucht, einen Ordner zu löschen, der nicht leer ist.

[elta33 10]

Hat ne Weile gedauert das Log zu Prüfen, aber jetzt ist alles klar. Liegt nicht an Rechten, die sind OK, händisch löschen war dann auch möglich...

 

Das Script hat Probleme mit leeren Ordnern (komplett ohne Dateien!), aber nur manchmal. Ich konnte zwei Varianten unterscheiden. Ich hatte mal mit Delage32 bei diesen Daten gearbeitet, bis ich mitbekam, dass nur die Dateien, nicht aber die Ordner gelöscht wurden. Diese Ordner konnte das Script nicht Löschen, per Hand gings sofort.

 

Außerdem konnte ich anhanh des LOGs nachvollziehen, dass bei einigen Ordnern vom Script alle Dateien und Unterordner gelöscht würden aber beim Hautordner kam dann der Fehler. Manuell gings auch hier sofort.

 

Habe nun erstmal alles bereinigt und werde weiter Testen.

Die meisten Ordner wurden, wie vorgesehen, gelöscht. Die Rechte sind OK, macht nicht wirklich sind...

[Cybquest 36]

Möglicherweise versucht das Script zu schnell, den Ordner zu löschen (bevor wirklich alle Dateien verschwunden sind). Nachstelen konnte ich es bei mir noch nicht.

Hab aber vorsichtshalber das Script erweitert. Nun werden, wenn ein Ordner nicht gelösht werden kann, 3 Versuche unternommen. Die Wartezeit zwischen den Versuchen kann parametriert werden.

Hier die Erweiterungen. Folgende 2 Zeilen in den "Variablen-Block" packen:

lngRetries = 3 'Anzahl Versuche, wenn Ordner-löschen fehlschlägt 
lngRetSleepTime = 1000 'Wartezeit nach Fehlversuch in ms

 

Und den Block "Ordner löschen" durch folgenden Code ersetzten:

      'Ordner löschen
     i = 1
     do
       Err.Clear
       fso.DeleteFolder(strFolder)
       if Err = 0 then
         writelog "Ordner " & strFolder & " gelöscht"
       else
         if i > 1 then strRet = "- " & i & ".Versuch!" else strRet = ""
         writelog "Ordner " & strFolder & " konnte nicht gelöscht werden! - Fehler " & Err & " (" & Err.Description & ") " & strRet
         wscript.sleep lngRetSleepTime
       end if
       i = i + 1
     loop until (Err = 0) or (i > lngRetries)

[elta33 10]

Im Moment kann ich es leider nicht Testen, da die Problemordner ja manuell gelöscht wurden. Ich glaube aber eher nicht dass es daran liegt. Ich habe das Script im Anschluss neu gestartet und auch beim zweiten Versuch wurden die zu dem Zeitpunkt bereits leeren Ordner nicht gelöscht. Deshalb hatte ich mich dann zum "per Hand" Löschen entschieden.

 

Ich werde das im Auge behalten und weiter Berichten.