Alternative save method VBA

[nparsons75]

Hi, I am using the following code to save a backup version of my file each time I save. Does anyone have an alternative, this seems very slow and for some reason saves 3 times? It works but is very slow. Thank you in advance.

Private Sub Workbook_AfterSave(ByVal Success As Boolean)If Not Success Then Exit Sub
Const backupFolder = "S:\BUSINESS IMPROVEMENT\BACKUPS"


Dim savedName As String
Dim backupName As String
Dim dotFinder As Long


Application.EnableEvents = False
savedName = ThisWorkbook.FullName
backupName = backupFolder & Mid$(savedName, InStrRev(savedName, "\"))
dotFinder = InStrRev(backupName, ".")
backupName = Left$(backupName, dotFinder) & Format$(Now(), "yyyymmddhhnnss.") & Mid$(backupName, dotFinder + 1)
If backupName = savedName Then Exit Sub
If Dir$(backupName) <> "" Then Kill backupName
ThisWorkbook.SaveAs backupName
Kill savedName
ThisWorkbook.SaveAs savedName
Application.EnableEvents = True


End Sub