Dateien nach X Tagen löschen Die Funktion DeleteFilesAfterXDays löscht automatisch, nach einer bestimmten Anzahl von Tagen, Dateien eines Ordners
Autor:   Dennis Hemken	Bewertung:     [ Jetzt bewerten ]	Views:  15.339
gadgets.hemken.org	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 34 Bewertung insgesamt: sehr gut Durchschnittliche Bewertung: 5.0 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Man kennt es sicher: man schreibt die eine oder andere Routine, um etwas in Textdateien zwischen zu speichern und vergisst nachher das Löschen dieser Dateien.

Oder man hat eine Logging-Routine, die Flatfiles für eine Datenbank erzeugt, jedoch nach dem Import nicht automatisch löscht.

Das hat nun ein Ende! Mit der Funktion DeleteFilesAfterXDays hat man die Möglichkeit einen Ordner anzugeben, der nach alten Dateien sucht und diese löscht. Mehr dazu im Quellcode...

Quellcode:

' Löscht alle Dateien eines Ordners, die älter als x Tage sind
Public Function DeleteFilesAfterXDays(ByVal strFilePath As String, _
  Optional ByVal lngFileAge As Long = 10, _
  Optional ByVal strFileType As String = "") As Long
 
  Dim lngDeletetFiles As Long
  Dim dtmFileCreated As Date
  Dim objFSO As Object
  Dim objFolder As Object
  Dim colFile As Object
  Dim objFile As Object
 
  ' Fehlerbehandlung aktivieren
  On Error GoTo ErrHandler
 
  ' Laufparameter für das Gesamtergebnis der gelöschten Dateien
  lngDeletetFiles = 0
 
  ' Verweis auf das FileSystemObject erstellen
  Set objFSO = CreateObject("Scripting.FileSystemObject")
 
  ' Verweis auf den übergebenen Pfad setzen
  Set objFolder = objFSO.GetFolder(strFilePath)
 
  ' Verweis auf die Dateien im übergebenen Pfad setzen
  Set colFile = objFolder.Files
 
  ' Schleife über alle Dateien im Ordner
  For Each objFile In colFile
 
    With objFile
      ' Prüfung nach dem Dateitypen, sprich der Dateiendung.
      ' Bei "" werden alle Dateien überprüft, ansonsten der
      ' an strFileType übergebene Dateityp, bestehend aus den
      ' letzten Buchstaben nach dem Punkt.
      If Len(strFileType) = 0 Or _
        Right$(.Name, Len(.Name) - InStrRev(.Name, ".")) = strFileType Then
 
        ' Dateierstellungsdatum der Datei auslesen
        dtmFileCreated = .DateCreated
 
        ' Datumdifferenz berechnen und mit der Anzahl der
        ' übergebenen Tagen in lngFileAge vergleichen
        If DateDiff("d", dtmFileCreated, Now()) > lngFileAge Then
 
          ' Bei Überschreitung der Altersgrenze, wird die Datei gelöscht
          .Delete
          lngDeletetFiles = lngDeletetFiles + 1
        End If
      End If
    End With
  Next 
 
  ' Anzahl der gelöschten Dateien übergeben
  DeleteFilesAfterXDays = lngDeletetFiles
 
ErrHandler:
  ' Objekte zerstören
  Set objFolder = Nothing
  Set objFSO = Nothing
  Set colFile = Nothing
  Set objFile = Nothing
End Function

Ein möglicher Aufruf könnte so aussehen:

Dim strPath As String
Dim lngAge As Long
Dim lngAusgabe As Long
Dim strType As String
 
strPath = "C:\Temp"
lngAge = 14
strType = "bak"
 
lngAusgabe = DeleteFilesAfterXDays(strPath, lngAge, strType)
Debug.Print "Es wurden " & lngAusgabe & " Dateien aus dem Ordner " & strPath & " gelöscht"