vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#

https://www.vbarchiv.net
Rubrik: Dateisystem · Dateien allgemein   |   VB-Versionen: VB626.04.10
Dateien nach X Tagen löschen

Die Funktion DeleteFilesAfterXDays löscht automatisch, nach einer bestimmten Anzahl von Tagen, Dateien eines Ordners

Autor:   Dennis HemkenBewertung:  Views:  14.716 
gadgets.hemken.orgSystem:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

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"



Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
 
Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.


Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.