AW: Anzahl Backup-Dateien begrenzen
27.06.2018 15:17:39
UweD
Hallo
so?
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim SavePath As String
Dim FileName As String
Dim FileExtension As String
Dim FileDate As String
Dim FileBackupName As String
Dim FileUsername As String
Dim Datei As String
Dim DatAlt As String
Dim DateiLösch As String
Dim x As Long
Dim Zähler As Long
Dim MMax As Integer
SavePath = ThisWorkbook.Path & "\Backup\"
FileName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)
FileExtension = Mid(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") + 1)
FileUsername = Environ("UserName")
FileDate = Format(Now, "YYYYmmdd_hhmmss")
MMax = Worksheets("Tabelle1").Range("B1").Value
'--- letztes Backup löschen
x = Len(FileName & "_" & FileUsername & "_") + 1
DatAlt = "ZZZ"
Datei = Dir(SavePath & FileName & "_" & FileUsername & "_*." & FileExtension)
Do While Datei <> ""
Zähler = Zähler + 1
If Mid(Datei, x) < DatAlt Then
DatAlt = Mid(Datei, x)
DateiLösch = Datei
End If
Datei = Dir
Loop
Worksheets("Tabelle1").Range("B2").Value = Zähler
If Zähler > MMax Then Kill SavePath & DateiLösch
FileBackupName = SavePath & FileName & "_" & FileUsername & "_" & FileDate & "." & _
FileExtension
ActiveWorkbook.SaveCopyAs FileBackupName
End Sub
der Zählervergleich wird ja erst vorgenommen, wenn keine Datei mehr gefunden wurde. Dann ist DIR(..) aber schon "".
LG UweD