bluemerson
Feb 09, 2020, updated at Feb 10, 2020 (UTC)
view2540
view21
0
Goto Top

VBA - Script zum Löschen von Dateien die mehr als X Tage alt sind

GermanQuestionVB for ApplicationsDevelopment
Hallo zusammen,

ich habe folgendes Script im Einsatz und suche nun noch nach der Lösung, ggf. gewisse Dateien bzw. ganze Ordner auf dem Laufwerk vom Löschen auszuschließen.

Wer könnte mir da behilflich sein?

Schöne Grüße


Script:

' *
' * Programm: LoescheAlteDateien.vbs *
' * Funktion: löscht nicht gewollte Verzeichnisse auf Laufwerk U: *
' *

Option Explicit

Dim oFSO, oDatei, oFolder, oFileCol, oProt ' Objekte
Dim cVZ(), cMsg(), cPrefix(0), cListe1(), cTmp, cDir, cAusnahme, cProt ' Strings
Dim iPointer, iLoop, iLoop1, iMsg, iTage ' Integers
Dim dDatum ' Datum

iMsg = 1
Redim cMsg(1)
cMsg(0) = "'"
cMsg(1) = "Routine gestartet am " + cstr(date) + " um " + cstr(time) + " Uhr"

Set oFSO = CreateObject("Scripting.FileSystemObject")

'*
' Hier Einstellungen anpassen
'*
cPrefix(0) = "U:\" ' Pfad zum Arbeitsverzeichnis
Const ResCloud = "\\..." ' UNC Pfad zum Arbeitsverzeichnis
Const bDontKeepMappings = False
'Const NetUseUser = ""
'Const NetUseUserPw = ""

cProt = "D:\.log" ' Protokoll-Datei
iTage = 7 ' Vorhalte-Zeitraum der Dateien in Tagen
'*
Dim oNetwork : Set oNetwork = WScript.CreateObject("WScript.Network")
oNetwork.MapNetworkDrive "U:", ResCloud, bDontKeepMappings

'*
' Verzeichnisse einlesen
'*
Call LeseVZ(cListe1, cPrefix(0)) ' Arbeitsverzeichnis


'*
' alte Dateien löschen (älter als iTage)
'*
dDatum = DateAdd("d", iTage * -1, now)
Call LeseVZ(cListe1, cPrefix(0))
For iLoop = 0 To ubound(cListe1)
Set oFolder = oFSO.GetFolder(cPrefix(0) + cListe1(iLoop))
Set oFileCol = oFolder.Files
For Each oDatei In oFileCol
If oDatei.DateLastModified < dDatum And right(oDatei.Name, 13) <> "NichtLoeschen" Then
iMsg = iMsg + 1
Redim preserve cMsg(iMsg)
cMsg(iMsg) = "Datei gelöscht: " + cListe1(iLoop) + "\" + oDatei.Name + " (" + cstr(oDatei.Size) + " Bytes)"
Call oDatei.Delete(True)
End If
Next
Next

'*
' Protokoll beenden und speichern
'*
oNetwork.RemoveNetworkDrive "U:"

iMsg = iMsg + 1
Redim preserve cMsg(iMsg)
cMsg(iMsg) = "Routine beendet am " + cstr(date) + " um " + cstr(time) + " Uhr"
Set oProt = oFSO.OpenTextFile(cProt, 8, True)
For iLoop = 0 To ubound(cMsg)
oProt.WriteLine(cMsg(iLoop))
Next
oProt.Close

WScript.Quit

'
'* Unter-Routinen *
'

'
' GetSubFolders: rekursives Einlesen der Verzeichnisse -> wird von LeseVZ aufgerufen
'
Sub GetSubFolders
dim oVZ, oFolderCol, oFolder, iTmp

iTmp = iPointer
set oVZ = oFSO.GetFolder(cVZ(iPointer))
set oFolderCol = oVZ.SubFolders
for each oFolder in oFolderCol
iPointer = iPointer + 1
redim preserve cVZ(iPointer)
cVZ(iPointer) = cVZ(iTmp) + "\" + ucase(oFolder.Name)
call GetSubFolders
next
End Sub

'
' LeseVZ: liest Verzeichnisse rekursiv ein und entfernt Arbeits- bzw. Vorgabepfad
'**
Sub LeseVZ(cListe(), cPrefix)
iPointer = 0
Redim preserve cVZ(iPointer)
cVZ(iPointer) = cPrefix
Call GetSubFolders
Redim cListe(ubound(cVZ))
For iLoop1 = 0 To ubound(cVZ)
cListe(iLoop1) = mid(cVZ(iLoop1), len(cPrefix) + 1)
Next
End Sub
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 545667

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

Printed on: April 25, 2024 at 17:04 o'clock

21 Comments
Latest comment
Goto Top
Member: em-pie
em-pie Feb 09, 2020 at 20:39:29 (UTC)
Goto Top
Moin,

Hast du hier einmal geschaut:

https://gallery.technet.microsoft.com/scriptcenter/2a2927b7-7525-4777-8d ...
Gruß
em-pie
Member: Bluemerson
Bluemerson Feb 10, 2020 updated at 07:15:05 (UTC)
Goto Top
Hi, danke für die Rückmeldung.

Das Löschen klappt tadellos.

Ich suche jetzt noch die Befehlszeile / Lösung für das Ausschließen einzelner Dateien/Ordner in dem Script.

Schöne Grüße
Member: emeriks
emeriks Feb 10, 2020 updated at 08:02:39 (UTC)
Goto Top
Hi,
Du solltest mal den Betreff der Frage ändern, denn ich glaube nicht, dass Du das u.g. willst
die mehr als X Tage im Ordner existieren
sondern
"die mehr als X Tage alt sind".
Oder?

Das Löschen klappt tadellos.
Womit? Mit Deinem Script (bitte nutze doch Code-Tags!) oder das aus dem von @em-pie genannten Link?

E.
Member: Bluemerson
Bluemerson Feb 10, 2020 at 07:56:24 (UTC)
Goto Top
Hi @emeriks,

die Fragestellung habe ich nun im Betreff geändert. Die Begrifflichkeit war in der Tat nicht ganz richtig face-wink

Mein Script hatte ich oben in der Frage eingefügt. Ist dies nicht ersichtlich?

Schöne Grüße
Member: Bluemerson
Bluemerson Feb 10, 2020 at 07:58:13 (UTC)
Goto Top
' *  
' * Programm: LoescheAlteDateien.vbs *  
' * Funktion: löscht nicht gewollte Verzeichnisse auf Laufwerk U: *  
' *  

Option Explicit

Dim oFSO, oDatei, oFolder, oFileCol, oProt ' Objekte  
Dim cVZ(), cMsg(), cPrefix(0), cListe1(), cTmp, cDir, cAusnahme, cProt ' Strings  
Dim iPointer, iLoop, iLoop1, iMsg, iTage ' Integers  
Dim dDatum ' Datum  

iMsg = 1
Redim cMsg(1)
cMsg(0) = "'"  
cMsg(1) = "Routine gestartet am " + cstr(date) + " um " + cstr(time) + " Uhr"  

Set oFSO = CreateObject("Scripting.FileSystemObject")  

'*  
' Hier Einstellungen anpassen  
'*  
cPrefix(0) = "U:\" ' Pfad zum Arbeitsverzeichnis  
Const ResCloud = "\\..." ' UNC Pfad zum Arbeitsverzeichnis  
Const bDontKeepMappings = False
'Const NetUseUser = ""  
'Const NetUseUserPw = ""  

cProt = "D:\.log" ' Protokoll-Datei  
iTage = 7 ' Vorhalte-Zeitraum der Dateien in Tagen  
'*  
Dim oNetwork : Set oNetwork = WScript.CreateObject("WScript.Network")  
oNetwork.MapNetworkDrive "U:", ResCloud, bDontKeepMappings  

'*  
' Verzeichnisse einlesen  
'*  
Call LeseVZ(cListe1, cPrefix(0)) ' Arbeitsverzeichnis  


'*  
' alte Dateien löschen (älter als iTage)  
'*  
dDatum = DateAdd("d", iTage * -1, now)  
Call LeseVZ(cListe1, cPrefix(0))
For iLoop = 0 To ubound(cListe1)
Set oFolder = oFSO.GetFolder(cPrefix(0) + cListe1(iLoop))
Set oFileCol = oFolder.Files
For Each oDatei In oFileCol
If oDatei.DateLastModified < dDatum And right(oDatei.Name, 13) <> "NichtLoeschen" Then  
iMsg = iMsg + 1
Redim preserve cMsg(iMsg)
cMsg(iMsg) = "Datei gelöscht: " + cListe1(iLoop) + "\" + oDatei.Name + " (" + cstr(oDatei.Size) + " Bytes)"  
Call oDatei.Delete(True)
End If
Next
Next

'*  
' Protokoll beenden und speichern  
'*  
oNetwork.RemoveNetworkDrive "U:"  

iMsg = iMsg + 1
Redim preserve cMsg(iMsg)
cMsg(iMsg) = "Routine beendet am " + cstr(date) + " um " + cstr(time) + " Uhr"  
Set oProt = oFSO.OpenTextFile(cProt, 8, True)
For iLoop = 0 To ubound(cMsg)
oProt.WriteLine(cMsg(iLoop))
Next
oProt.Close

WScript.Quit

'  
'* Unter-Routinen *  
'  

'  
' GetSubFolders: rekursives Einlesen der Verzeichnisse -> wird von LeseVZ aufgerufen  
'  
Sub GetSubFolders
dim oVZ, oFolderCol, oFolder, iTmp

iTmp = iPointer
set oVZ = oFSO.GetFolder(cVZ(iPointer))
set oFolderCol = oVZ.SubFolders
for each oFolder in oFolderCol
iPointer = iPointer + 1
redim preserve cVZ(iPointer)
cVZ(iPointer) = cVZ(iTmp) + "\" + ucase(oFolder.Name)  
call GetSubFolders
next
End Sub

'  
' LeseVZ: liest Verzeichnisse rekursiv ein und entfernt Arbeits- bzw. Vorgabepfad  
'**  
Sub LeseVZ(cListe(), cPrefix)
iPointer = 0
Redim preserve cVZ(iPointer)
cVZ(iPointer) = cPrefix
Call GetSubFolders
Redim cListe(ubound(cVZ))
For iLoop1 = 0 To ubound(cVZ)
cListe(iLoop1) = mid(cVZ(iLoop1), len(cPrefix) + 1)
Next
End Sub
Member: Bluemerson
Bluemerson Feb 10, 2020 at 08:00:15 (UTC)
Goto Top
gesucht wird wie gesagt eine Lösung zum Ausschließen einzelner Dateien/Ordner in dem vorhandenen Script ...
Member: emeriks
emeriks Feb 10, 2020 at 08:08:20 (UTC)
Goto Top
Zitat von @Bluemerson:
gesucht wird wie gesagt eine Lösung zum Ausschließen einzelner Dateien/Ordner in dem vorhandenen Script ...

If not oDatei.Name <> "BlaBlaBla" then  
  'hier mit Löschen weitermachen  
end if

Oder
GanzVieleAusnahmen = Split("Ganz,viele,Ausnahmen", ",")  

IstAusnahme = False
For Each Ausnahme in GanzVieleAusnahmen 
  If oDatei.Name = Ausnahme then
    IstAusnahme = True
    Exit For
  end if
Next

If not IstAusnahme then
  'hier mit Löschen weitermachen  
end if

oder ähnlich.
Member: em-pie
em-pie Feb 10, 2020 at 08:09:31 (UTC)
Goto Top
WAS soll den ausgeschlossen werden?
Sind das namentlich genannte Dateien/ Ordner? Haben die ein Kriterium für Basis eines Attributes wie Datum, Größe, Pattern?
Member: Bluemerson
Bluemerson Feb 10, 2020 updated at 08:31:08 (UTC)
Goto Top
@em-pie

Leider sehr unterschiedlich ...
Es gibt Bereiche, deren Ordner sollen ausgeschlossen werden, aber es gibt auch die ein oder andere wichtige Datei (zwar älter als 30 Tage), die nicht gelöscht werden darf, aber ebenfalls auf dem Laufwerk liegt, wo das Lösch-Script täglich läuft ...

Gruß
Member: Bluemerson
Bluemerson Feb 10, 2020 updated at 08:30:56 (UTC)
Goto Top
@emeriks

Vielen Dank!
Wie würde das mit ganzen Ordnern aussehen? Ordner kommen häufiger vor wie Dateien.
Aber für Dateien könnte ich es schon mal testen.

Vielen Dank und VG
Member: emeriks
emeriks Feb 10, 2020 at 09:31:30 (UTC)
Goto Top
Na analog, nur eben statt über
oDatei.Name
dann eben über
oDatei.ParentFolder.Name
oder
oDatei.ParentFolder.Path
Member: 1st1
1st1 Feb 10, 2020 at 11:41:34 (UTC)
Goto Top
Würde ich direkt auf dem Server laufen lassen, auf dem das Share liegt:

rem aufraeum.cmd
set days=20
set exclude=/xf *.jpg /xf *.bmp /xd backup
set source=d:\data\freigabe
set target=d:\data\nichtfreiegeben
set options=/mov /e /s /minage:%days%

robocopy %options% %exclude% %source% %target%
del /s /f /q %target%\*.*
Member: Bluemerson
Bluemerson Feb 11, 2020 updated at 20:08:14 (UTC)
Goto Top
Zitat von @1st1:

Würde ich direkt auf dem Server laufen lassen, auf dem das Share liegt:

rem aufraeum.cmd
> set days=20
> set exclude=/xf *.jpg /xf *.bmp /xd backup
> set source=d:\data\freigabe
> set target=d:\data\nichtfreiegeben
> set options=/mov /e /s /minage:%days%
> 
> robocopy %options% %exclude% %source% %target%
> del /s /f /q %target%\*.*

Werde ich direkt mal versuchen - Vielen Dank!
Update: leider ohne Erfolg - da ist gar nichts passiert, wenn ich die cmd so aufbaue ...
Wo könnte der Fehler liegen? Wie sieht dann die vbs dazu aus?
Member: Bluemerson
Bluemerson Feb 11, 2020 updated at 20:37:54 (UTC)
Goto Top
Zitat von @emeriks:

Na analog, nur eben statt über
oDatei.Name
dann eben über
oDatei.ParentFolder.Name
oder
oDatei.ParentFolder.Path

Hi, an welche Stelle müsste denn "oDatei.ParentFolder.Name or Path" geschrieben werden ?

Habe gesehen, dass es in meinem Script schon folgende Zeile gibt:

If oDatei.DateLastModified < dDatum And right(oDatei.Name, 13) <> "NichtLoeschen" Then

Um es mal praxisnaher zu bringen ... ein Verzeichnis welches nicht gelöscht werden sollte, lautet P:\Transfer\Marketing
Wie müsste ich das dann mit diesem gen. Pfad im Script abbilden und an welcher Stelle? Und wie verhält es sich bei gleich mehreren Verzeichnissen?

Vielen Dank vorab für deine Hilfe.
Member: emeriks
emeriks Feb 12, 2020 at 07:04:43 (UTC)
Goto Top
Ich lönnte Dir also jetzt ein Kommando zum Löschen all Deiner Daten unterjubeln und Du würdest es nicht merken.

GanzVieleAusnahmen = Split("Ganz,viele,Ausnahmen,und,dann,noch,P:\Transfer\Marketing", ",")  

IstAusnahme = False
For Each Ausnahme in GanzVieleAusnahmen 
  If oDatei.Name = Ausnahme or _
      oDatei.ParentFolder.Path = Ausnahme  then
    IstAusnahme = True
    Exit For
  end if
Next

If not IstAusnahme then
  'hier mit Löschen weitermachen  
end if

Nicht getestet.
Member: Bluemerson
Bluemerson Feb 12, 2020 at 08:11:10 (UTC)
Goto Top
Zitat von @emeriks:

Ich könnte Dir also jetzt ein Kommando zum Löschen all Deiner Daten unterjubeln und Du würdest es nicht merken.

> GanzVieleAusnahmen = Split("Ganz,viele,Ausnahmen,und,dann,noch,P:\Transfer\Marketing", ",")  
> 
> IstAusnahme = False
> For Each Ausnahme in GanzVieleAusnahmen 
>   If oDatei.Name = Ausnahme or _
>       oDatei.ParentFolder.Path = Ausnahme  then
>     IstAusnahme = True
>     Exit For
>   end if
> Next
> 
> If not IstAusnahme then
>   'hier mit Löschen weitermachen  
> end if
>

Nicht getestet.

Das wäre natürlich unschön - dann lass ich lieber die Finger davon ... Vielen Dank!
Member: emeriks
emeriks Feb 12, 2020 updated at 08:36:43 (UTC)
Goto Top
Zitat von @Bluemerson:
Das wäre natürlich unschön -
Das werde ich nicht tun. face-smile
Member: Bluemerson
Bluemerson Feb 12, 2020 at 09:31:27 (UTC)
Goto Top
Zitat von @emeriks:

Zitat von @Bluemerson:
Das wäre natürlich unschön -
Das werde ich nicht tun. face-smile

Meine Frage wäre jetzt nochmal: Kann ich den Befehl in die bereits vorhandene Zeile einfügen oder gänzlich ersetzen? Wenn ja, in welcher Zeile dann? Es wäre schön, wenn du/sie dann mein vorhandenes Script ergänzen könnten - Vielen Dank vorab.
Member: emeriks
emeriks Feb 12, 2020 at 09:36:44 (UTC)
Goto Top
Am Script-Anfang
GanzVieleAusnahmen = Split("Ganz,viele,Ausnahmen,und,dann,noch,P:\Transfer\Marketing", ",")

Zweilen 49 - 56 ersetzen/ergänzen mit
For Each oDatei In oFileCol

  If oDatei.DateLastModified < dDatum Then
  
    IstAusnahme = False
    For Each Ausnahme in GanzVieleAusnahmen 
      If oDatei.Name = Ausnahme or _
          oDatei.ParentFolder.Path = Ausnahme  then
        IstAusnahme = True
        Exit For
      end if
    Next

    If not IstAusnahme then
        iMsg = iMsg + 1
        Redim preserve cMsg(iMsg)
        cMsg(iMsg) = "Datei gelöscht: " + cListe1(iLoop) + "\" + oDatei.Name + " (" + cstr(oDatei.Size) + " Bytes)"  
        Call oDatei.Delete(True)
    End If

  End if

Next
Member: Bluemerson
Bluemerson Feb 12, 2020 updated at 11:20:31 (UTC)
Goto Top
Zitat von @emeriks:

Am Script-Anfang
> GanzVieleAusnahmen = Split("Ganz,viele,Ausnahmen,und,dann,noch,P:\Transfer\Marketing", ",")  
>


Was hat es damit auf sich? also der Klammerinhalt - ist dort der Pfad ausreichend, der nicht gelöscht werden soll? getrennt mit Komma?


Zweilen 49 - 56 ersetzen/ergänzen mit
> For Each oDatei In oFileCol
> 
>   If oDatei.DateLastModified < dDatum Then
>   
>     IstAusnahme = False
>     For Each Ausnahme in GanzVieleAusnahmen 
>       If oDatei.Name = Ausnahme or _
>           oDatei.ParentFolder.Path = Ausnahme  then
>         IstAusnahme = True
>         Exit For
>       end if
>     Next
> 
>     If not IstAusnahme then
>         iMsg = iMsg + 1
>         Redim preserve cMsg(iMsg)
>         cMsg(iMsg) = "Datei gelöscht: " + cListe1(iLoop) + "\" + oDatei.Name + " (" + cstr(oDatei.Size) + " Bytes)"  
>         Call oDatei.Delete(True)
>     End If
> 
>   End if
> 
> Next
>

Würde ich einfügen und dann nochmal hier komplett posten, zum Korrektur lesen face-smile
Member: emeriks
emeriks Feb 12, 2020 updated at 11:28:39 (UTC)
Goto Top
Zitat von @Bluemerson:
Was hat es damit auf sich? also der Klammerinhalt - ist dort der Pfad ausreichend, der nicht gelöscht werden soll? getrennt mit Komma?
Du solltest es nicht übertreiben!

In diesem Beispiel: Ja, mit Komma getrennt. Oder wenn nur genau 1 Wert, dann eben kein Komma, weil es ja dann nichts zu trennen gibt.

VBScript Split Function

Tipp:
Wenn Du diese Auswertung extrem verlangsamen willst, dann kannst Du auch das nehmen:
GanzVieleAusnahmen = Split("Wenn,Du,diese,Auswertung,extrem,verlangsamen,willst,,dann,kannst,Du,auch,nehmen:,Wenn,Du,diese,Auswertung,extrem,verlangsamen,willst,,dann,kannst,Du,auch,nehmen:,Wenn,Du,diese,Auswertung,extrem,verlangsamen,willst,,dann,kannst,Du,auch,nehmen:,Wenn,Du,diese,Auswertung,extrem,verlangsamen,willst,,dann,kannst,Du,auch,nehmen:,Wenn,Du,diese,Auswertung,extrem,verlangsamen,willst,,dann,kannst,Du,auch,nehmen:,Wenn,Du,diese,Auswertung,extrem,verlangsamen,willst,,dann,kannst,Du,auch,nehmen:,Wenn,Du,diese,Auswertung,extrem,verlangsamen,willst,,dann,kannst,Du,auch,nehmen:,Wenn,Du,diese,Auswertung,extrem,verlangsamen,willst,,dann,kannst,Du,auch,nehmen:,Wenn,Du,diese,Auswertung,extrem,verlangsamen,willst,,dann,kannst,Du,auch,nehmen:,Wenn,Du,diese,Auswertung,extrem,verlangsamen,willst,,dann,kannst,Du,auch,nehmen:,Wenn,Du,diese,Auswertung,extrem,verlangsamen,willst,,dann,kannst,Du,auch,nehmen:,Wenn,Du,diese,Auswertung,extrem,verlangsamen,willst,,dann,kannst,Du,auch,nehmen:,Wenn,Du,diese,Auswertung,extrem,verlangsamen,willst,,dann,kannst,Du,auch,nehmen:,Wenn,Du,diese,Auswertung,extrem,verlangsamen,willst,,dann,kannst,Du,auch,nehmen:,P:\Transfer\Marketing", ",")
Den Umkehrschluss überlasse ich jetzt Dir.
GermanQuestionVB for ApplicationsDevelopment
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 5 Comments