Rubrik: Dateisystem · Dateien allgemein | VB-Versionen: VB6 | 26.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 Hemken | Bewertung: | Views: 14.716 |
gadgets.hemken.org | System: 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"