Office: nach Datum im Dateinamen löschen

Macanudo · 28. Oktober 2018

Guten Morgen in die Runde,

ich suche eine Möglichkeit zum löschen von Dateien, die älter als 2 Jahre sind. Habe einen Code gefunden, der mir nach Erstellungsdatum, so wie ich den Code verstanden habe, die Dateien aus dem Ordner löscht.

Nun ist es so, dass ich die Dateien bekomme und in den Ordner kopieren muss. Damit ändert sich aber das Erstellungsdatum. Die Dateien sind aber manchmal dann schon fast ein Jahr alt. Deshalb der Weg über das Datum im Dateinamen. Der Aufbau des Dateinamen ist immer: "Kontrolldatei 27.10.2018.pdf" Das Datum ändert sich natürlich.

Anbei der Code den ich gefunden habe. Kann man diesen anpassen.

Vielen Dank für die Hilfe.

Viele Grüße

Uwe

Code:

Sub löschen()
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

srcFolder = "C:/Eigene Dateien/Test/Testordner/"

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

xDel = 1

For Each myFile In myFldFiles
Debug.Print myFile.Name
If myFile.DateCreated < Now - xDel Then

Kill myFile

End If

Next
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

:)

MisterBurns · 29. Oktober 2018

Wieso nicht einfach einmal im Monat händisch im Windows Explorer löschen? Ist doch eine Aufgabe von maximal 30 Sekunden, wenn der Namensaufbau immer gleich ist.

Macanudo · 29. Oktober 2018

Ich wollte es etwas automatisieren. Denn wenn ich nicht da bin kam es schon vor, dass die Leute etwas mehr markieren als notwendig ist, und dann Dateien weg sind, die noch gar nicht gelöscht werden sollten.

Deshalb der Weg.

Viele Grüße

Uwe

gklumpp · 31. Oktober 2018

Hi Uwe,

versuche mal das

Code:

Sub löschen()
Dim myFSO As Object, myFld As Object, myFldFiles As Object
Dim myFile As Object
Dim i As Long
' Dim xDel As Byte
Dim srcFolder As String

' srcFolder = "C:/Eigene Dateien/Test/Testordner/"
srcFolder = "D:X_Down"

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

' xDel = 1 nicht mehr nötig

For Each myFile In myFldFiles
Debug.Print myFile.Name
' If myFile.DateCreated < Now - xDel Then
If Alter(CDate(Mid(myFile.Name, 15, 10))) >= 1 Then

MsgBox "Kill: " & myFile.Name
' Kill myFile

End If

Next
End Sub

Function Alter(GebDatum) As Integer
Alter = Year(Date) - Year(GebDatum)
If DateSerial(Year(Date), _
Month(GebDatum), Day(GebDatum)) > Date Then
Alter = Alter - 1
End If
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Macanudo · 1. November 2018

Guten Morgen Gerhard,

vielen Dank für Deine Hilfe.

Den Code habe ich eingesetzt, leider will er mir alle Dateien löschen, egal wie alt die sind. Geht der Code auf das Datum in Datei Namen ein?

Was muss man da anpassen, dass er mir alle Dateien löscht, die älter als 2 Jahre sind?

Vielen Dank.

Viele Grüße

Uwe

Code:

Sub löschen()
Dim myFSO As Object, myFld As Object, myFldFiles As Object
Dim myFile As Object
Dim i As Long
' Dim xDel As Byte
Dim srcFolder As String

' srcFolder = "C:/Eigene Dateien/Test/Testordner/"
srcFolder = "D:X_Down"

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

' xDel = 1 nicht mehr nötig

For Each myFile In myFldFiles
Debug.Print myFile.Name
' If myFile.DateCreated < Now - xDel Then
If Alter(CDate(Mid(myFile.Name, 15, 10))) >= 1 Then

MsgBox "Kill: " & myFile.Name
' Kill myFile

End If

Next
End Sub

Function Alter(GebDatum) As Integer
Alter = Year(Date) - Year(GebDatum)
If DateSerial(Year(Date), _
Month(GebDatum), Day(GebDatum)) > Date Then
Alter = Alter - 1
End If
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

gklumpp · 1. November 2018

Hi Uwe,

für 2 Jahre ändere den Vergleich in
>= 2

Mit meinen Test PDFs "Kontrolldatei 02.11.2016.pdf" vom 1. bis 4.11. werden die vom 1. und 2.11 gelöscht, die ab 3.11 bleiben.

Macanudo · 1. November 2018

Hallo Gerhard,

jetzt löscht er mir nicht mehr alles, aber auch nicht die ganz alten Sachen. Er löscht mir zum Beispiel nichts, was vor dem 30.10.2016 kommt. Und es kommt eine Fehlermeldung "Typenunverträglichkeit", wenn der Name von Kontrolldatei in Rechnung oder etwas anderes geändert wird. z. B. "Rechnung Kalender 25.04.2015.pdf"

Vielen Dank.

Viele Grüße

Uwe

gklumpp · 2. November 2018

Hi Uwe,

wenn es noch andere Dateinamen als Kontrolldatei gibt kann das passieren *wink.gif* Tausche den Vergleich hiermit aus

If Alter(CDate(Mid(myFile.Name, InStr(myFile.Name, ".") - 2, 10))) >= 2 Then

Vor dem Datum im Namen dürfen dann keine "." stehen

Macanudo · 3. November 2018

Hallo Gerhard,

jetzt funktioniert es wunderbar. Vielen lieben Dank für Deine Hilfe.

Damit ist das Thema erledigt und geschlossen.

Viele Grüße

Uwe

Office: nach Datum im Dateinamen löschen

nach Datum im Dateinamen löschen

nach Datum im Dateinamen löschen

nach Datum im Dateinamen löschen

nach Datum im Dateinamen löschen

nach Datum im Dateinamen löschen - Similar Threads - Datum Dateinamen löschen

Serienbrief, Datum plus 7 Tage

letztes Datum finden

Datum Suchen

Hinzufügen von Dateiname, Datum, Autor oder anderen Dokumenteigenschaften zu einer Kopf-oder ...

Makro Arbeitsmappe speichern unter mit Datum und Dateinamen

Gespeicherter Export mit Datum als Prefix für den Dateinamen

Datum in Dateinamen einbauen