'vorher bitte die Microsoft Scripting Runtime über Menü Projekt/Verweise... einbinden
'diese Version ist nun getestet (was jeder Entwickler immer tun sollte!)
Sub Main()
Dim iTage As Integer
'wieviele Tage die Datei alt sein muss
iTage = 2
LoescheDateien iTage
End Sub
Private Sub LoescheDateien(ByVal Tage As Integer)
'Diese Routine löscht alle Text-Dateien die sich
'im aktuellen Programmverzeichnis befinden und älter
'als x Tage sind
'Parameter: Tage wieviele Tage die Datei alt sein muss
Dim FSO As Object
Dim Datei As File
Dim Dateien As Files
Dim Ordner As Folder
Dim sDateiName As String
Dim sPfad As String
Dim DateiDatum As Date
Set FSO = CreateObject("Scripting.FileSystemObject")
'zum aktuellen Datum Tage addieren
DateiDatum = DateAdd("D", -Tage, Format(Now, "dd.mm.yyyy"))
sPfad = App.Path
'Ordner festlegen
Set Ordner = FSO.GetFolder(sPfad)
Set Dateien = Ordner.Files
'Pfad ohne Backslash am Ende formatieren
If Right(sPfad, 1) = "\" Then sPfad = Left(sPfad, Len(sPfad) - 1)
'Dateien im aktuellen Programmverzeichnis durchlaufen
For Each Datei In Dateien
'Dateipfad zusammensetzen
sDateiName = sPfad + "\" + Datei.Name
'nach Text-Dateien filtern
If UCase(FSO.GetExtensionName(sDateiName)) = "TXT" Then
'Dateien älter als Tage löschen
If DateDiff("d", FileDateTime(sDateiName), Now) > Tage Then
'löschen erzwingen
FSO.DeleteFile sDateiName, True
End If
End If
Next
'Objekte zerstören
Set Ordner = Nothing
Set Dateien = Nothing
Set FSO = Nothing
End Sub
@Nerd: *lol* alle Dateien die jünger als 2 Tage oder 2 Tage alt sind werden bei Dir gelöscht...(Anforderung lesen, darüber nachdenken, Anforderung nochmal lesen weil Du sie nicht verstanden hast, dann darfst Du wieder posten :confused: ) buggy-boy :marine
Private Function proofDate2(ByRef strFilename As String, ByVal dCurrentDate As Date) As Boolean
'// tag von heute + 2 - prüfdatum
If Format((DateAdd("D", 2, dCurrentDate) - FileDateTime(strFilename)), "D") < KILLDAYS Then
proofDate2 = True
Else
proofDate2 = False
End If
End Function
