Backupdatei anlegen - nur 30 Files

Hallo,

ich habe einen Code, der mir eigentlich meine Backups in einem Ordner ablegt. Da der Ordner mit der Zeit zu voll wurde, habe ich die Anzahl der Files auf 30 begrenzen wollen. Jetzt habe ich aber gemerkt, dass er mir nicht das älteste Backupfile löscht, sondern irgendwie immer die letzte Datei zuvor. Kann mir jemand den Code berichtigen, wäre sehr dankbar.

Josch

Public Sub Backupdatei_anlegen()
   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
   

Application.DisplayAlerts = False
Application.EnableEvents = False
   
     SavePath = ThisWorkbook.Path & "\Backup\"
     
        If Dir(SavePath, vbDirectory) > "" Then
        Else
        MkDir ThisWorkbook.Path & "\Backup"
        End If
     
     FileName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)
     FileExtension = Mid(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") + 1)
     FileUsername = Environ("UserName")
     FileDate = Format(Now, "YYYY-MM-DD hh'mm'ss") & " Uhr"
     MMax = 30
     
     '--- letztes Backup löschen
     x = Len(FileName & "_" & FileUsername & "_") + 1
     DatAlt = "ZZZ"
     Datei = Dir(SavePath & FileName & "_*." & 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
     If Zähler > MMax Then Kill SavePath & DateiLösch
     
     FileBackupName = SavePath & FileName & "_" & FileDate & "." & FileExtension
     ActiveWorkbook.SaveCopyAs FileBackupName

    
Application.DisplayAlerts = True
Application.EnableEvents = True

End Sub