AW: Datumsdateien im gleichen Verzeichnis löschen
Ramses
Hallo
Hier gibt es zwei Unklarheiten:
Möchtest du die Dateien löschen, die älter sind als 2 Tage, und damit ist das ERSTELLUNGSDATUM gemeint, dann kannst du das probieren
Sub Delete_2DayOld_Files()
Dim myFSO As Object, myFld As Object, myFldFiles As Object
Dim myFile As Object
Dim i As Long, xDel As Byte
Dim srcFolder As String
'Zu durchsuchender Ordner
srcFolder = "C:\Test\"
'Definition des System Objectes
Set myFSO = CreateObject("scripting.FileSystemObject")
If myFSO.folderexists(srcFolder) = False Then
MsgBox "Der Ordner existiert nicht"
Exit Sub
End If
Set myFld = myFSO.getfolder(srcFolder)
Set myFldFiles = myFld.Files
'Tage ab wann gelöscht werden soll
xDel = 2
For Each myFile In myFldFiles
'Zur Kontrolle Ausgabe im Direktfenster
Debug.Print myFile.Name
'Löscht Dateien die älter sind als "xDel" Tage
If myFile.DateCreated < Now - xDel Then
MsgBox myFile.Name & ": Datei wäre zum löschen"
'Kill myFile
Else
Debug.Print "Nicht zum löschen: " & myFile.Name
End If
Next
End Sub
Wenn du Dateien löschen willst, die im Dateinamen ein Datum haben, das älter ist als 2 Tage, dann sowas
Sub Delete_2DaysOld_Filename_Files()
Dim myFSO As Object, myFld As Object, myFldFiles As Object
Dim myFile As Object
Dim xDel As Byte
Dim srcFolder As String
Dim timeInt As Integer
'Zu durchsuchender Ordner
srcFolder = "C:\Test\"
'Definition des System Objectes
Set myFSO = CreateObject("scripting.FileSystemObject")
If myFSO.folderexists(srcFolder) = False Then
MsgBox "Der Ordner existiert nicht"
Exit Sub
End If
Set myFld = myFSO.getfolder(srcFolder)
Set myFldFiles = myFld.Files
'Tage ab wann gelöscht werden soll
xDel = 2
For Each myFile In myFldFiles
'Zur Kontrolle Ausgabe im Direktfenster
Debug.Print myFile.Name
timeInt = CInt(Left(Right(myFile.Name, 10), 2))
'Löscht Dateien in deren Datum ein Tag vorkommt
'der älter ist als heute - 2 Tage
If timeInt < (Now - (Now - xDel)) Then
Debug.Print "Zu löschen: " & myFile.Name
MsgBox myFile.Name & ": Datei wäre zum löschen"
'Kill myFile
Else
Debug.Print "Nicht zum löschen: " & myFile.Name
End If
Next
End Sub
Das Hochkomma " ' " vor "Kill myFile" muss entfernt werden, um das Makro "scharf" zu machen.
Gruss Rainer