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

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

' *  
' * 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

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

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

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%\*.*

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%\*.*

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

> 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
> 

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

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

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

> 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
> 

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", ",")