Save & Backup Macro Question

[mayoung]

This macro saves a backup copy of the excel workbook within the same folder as the original and each time it runs it deletes the older backup.
Is there away to change the code so the backup is stored in different folder other than where the original is stored and still delete the older backup?

Lets say I want to store it on my C drive within a folder named Backup?

Sub SaveExit()
Dim fname As String, OldestFile As String, OldestDate As Date, Directory As String, CurrentName As String
CurrentName = ActiveWorkbook.Name
fname = ActiveWorkbook.Path & "\" & Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1) & " " & Format(Now, "dd-mmm-yy  hh-mm-ss") & ".xlsm"
'fname = ActiveWorkbook.Path & "\" & Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1) & Format(Date, "dd-mmm-yy") & " " & Format(Time, "hh-mm-ss") & ".xlsm"
ActiveWorkbook.SaveAs Filename:=fname, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Directory = ActiveWorkbook.Path
    If Right(Directory, 1) <> "\" Then Directory = Directory & "\"
    fname = Dir(Directory & "*.xlsm", 0)
    If fname <> "" Then
        OldestFile = fname
        OldestDate = FileDateTime(Directory & fname)
        Do While fname <> ""
            If FileDateTime(Directory & fname) < OldestDate Then
                 OldestFile = fname
                 OldestDate = FileDateTime(Directory & fname)
             End If
             fname = Dir
        Loop
    End If
ChDir ActiveWorkbook.Path
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=CurrentName, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Kill OldestFile
'MsgBox OldestFile
Application.DisplayAlerts = True
Application.Quit
End Sub

 

[TryingToLearn]

you can use the SaveCopyAs in your code or put this in the BEFORESAVE workbook module.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ipos
Dim ext
Dim fn
'FIND POSITION OF THE "."
ipos = InStr(Me.Name, ".")
'DEFINE ALL CHARACTERS AFTER THE "."
ext = Right(Me.Name, Len(Me.Name) - ipos)
SaveCopyAs "C:\Users\YOUR_NAME\Documents\Backup\fn & "_" & Format(Now, "yymmdd_hhmm") & "." & ext
End Sub

p.s. Code is straight out of my workbook, only changed YOUR_NAME. Thank you for the code to delete old files. I've just been doing that at the beginning of the month,

 

[mayoung]

But will this will not delete the Oldest backup?

you can use the SaveCopyAs in your code or put this in the BEFORESAVE workbook module.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ipos
Dim ext
Dim fn
'FIND POSITION OF THE "."
ipos = InStr(Me.Name, ".")
'DEFINE ALL CHARACTERS AFTER THE "."
ext = Right(Me.Name, Len(Me.Name) - ipos)
SaveCopyAs "C:\Users\YOUR_NAME\Documents\Backup\fn & "_" & Format(Now, "yymmdd_hhmm") & "." & ext
End Sub

p.s. Code is straight out of my workbook, only changed YOUR_NAME. Thank you for the code to delete old files. I've just been doing that at the beginning of the month,

 

[TryingToLearn]

This will not delete older files but as I said, you can use part of this code in yours or use it in BeforeSave then continue your macro to delete the old files. I will be adding the delete code to my macro at some point when I have more time to play with it.

 

[mayoung]

I will try to figure it out. If you figure it out can you please post your result here so I can see when you have time?

This will not delete older files but as I said, you can use part of this code in yours or use it in BeforeSave then continue your macro to delete the old files. I will be adding the delete code to my macro at some point when I have more time to play with it.