Dim
SavedBook
As
String
Const
MaxBooks = 5
Dim
I
As
Integer
Dim
BackupPfad
As
String
Dim
KillBook
As
String
Application.ScreenUpdating =
False
Application.DisplayAlerts =
False
BackupPfad = Environ(
"Userprofile"
) & "\Desktop\"
SavedBook = BackupPfad &
"Backup - *"
KillBook =
"Backup - 99999999999999.xlsm"
I = 0
SavedBook = Dir(SavedBook)
While
SavedBook <>
""
And
I < MaxBooks
If
KillBook > SavedBook
Then
KillBook = SavedBook
End
If
I = I + 1
SavedBook = Dir
Wend
If
I = MaxBooks
Then
Kill BackupPfad & KillBook
End
If
With
ActiveWorkbook
.SaveCopyAs BackupPfad &
"Backup - "
& _
Format(Now(),
"yyyymmddhhnnss"
) &
".xlsm"
End
With
Application.DisplayAlerts =
True
Application.ScreenUpdating =
True