Creating a backup that runs once a week

[dpaton05]

I have a spreadsheet that I want to create a backup copy of the file once a week upon opening, for instance, when the spreadsheet is opened, the date of the last backup is checked and if the date it was created is more than 1 week ago, it will create a backup file.

This spreadsheet has a folder called Backups in the same folder it is in, which is where the backups are to be stored. The filename of the backup files are to be structured like this. Firstly, it needs the word Backup, then the name of the file that is being backed up, without the extension then it needs the date and time that it was backed up. The format for the last bit needs to be dd.mm.yy MMHH AM/PM, for instance "Backup Filename 24.3.21 129PM"

I found a very similar post that I posted a bit under a year ago but it was asking for a daily backup. I want a weekly backup now and I was not quite sure how to modify it. A lot of the other details are the same but any details in this post, takes precedence over details in that post I found.

Backups

I have a spreadsheet that is going to record data that I don't want to lose. Therefore, I want to insert a feature that runs a daily backup and saves a copy of the entire workbook as a separate file. I need the file saved with the filename "Allocation sheets - dd.mm.yyyy". The dd.mm.yyyy...

www.mrexcel.com

I also want the ability to easily change the frequency of Backups. Possibly by having a cell that I can enter in weekly, fortnightly or monthly to set the frequency. This can be done on a sheet with the code name data, somewhere between A37:A50.

Could someone help me please?

 

[dpaton05]

I had an idea, maybe if another sheet was created, and the date and time entered in A1

1. When the sheet is saved initially, it enters a date and time in this cell
2. next time it is opened, the current date/time is compared to the date/time in this cell
3. if it is greater than 1 week, save a copy of the file in the backup folder
4. increment the row and enter the current date/time (A2)
5. now there is a new date/time to check against for making the weekly backup

It seems like an alright idea, could you help me code this please?

 

[dpaton05]

I have this code to save the file with the date and time but how do I change it so the word backup precedes the filename and it is stored in the backup folder of the current directory?

Sub BackupFile()
    Dim sFileName As String
    Dim sDateTime As String

    With ThisWorkbook
        sDateTime = " (" & Format(Now, "dd-mm-yy hhmm AM/PM") & ").xlsm"
        sFileName = Application.WorksheetFunction.Substitute _
          (.FullName, ".xlsm", sDateTime)
        .SaveCopyAs sFileName
    End With
End Sub

 

[dpaton05]

What is wrong with my syntax as it is not liking the .SaveCopyAs line

Sub BackupFile()
    Dim sFileName As String
    Dim sDateTime As String

    With ThisWorkbook
        sDateTime = " (" & Format(Now, "dd-mm-yy hhmm AM/PM") & ").xlsm"
        sFileName = Application.WorksheetFunction.Substitute _
          (.FullName, ".xlsm", sDateTime)
        .SaveCopyAs filename (ThisWorkbook.Path "\" & "Backups" & sFileName)
    End With
End Sub

 

[dpaton05]

I think I needed an & in there but now I get an error Method 'SaveCopyAs' of object workbook failed with this line highlighted,

.SaveCopyAs fileName:=ThisWorkbook.Path & "\" & "Backups" & "\" & sFileName

Sub BackupFile()
    Dim sFileName As String
    Dim sDateTime As String

    With ThisWorkbook
        sDateTime = " (" & Format(Now, "dd-mm-yy hhmm AM/PM") & ").xlsm"
        sFileName = Application.WorksheetFunction.Substitute _
          (.FullName, ".xlsm", sDateTime)
        .SaveCopyAs fileName:=ThisWorkbook.Path & "\" & "Backups" & "\" & sFileName
    End With
End Sub

 

[dpaton05]

Can you show me what I did wrong with that line Michael please?

 

[Michael M]

From memory one of your sheets ("Start") I think, had a logo in the Top Left Corner....I assumed that was a text box or shape.
MANUALLY type in the date in "A1" and the Today() formula in "A2" of that sheet BEHIND the logo....
If you then test the code below
1. with the current dates the same ....code should do nothing
2. adjust the date in "A1", so there is 7 days difference (older), retest the code

Sub BackupFile()
Dim sFileName As String, fname As String, fpath As String
fpath = ThisWorkbook.Path
fname = Format(Now, "dd-mm-yy hhmm AM/PM")
With Sheets("Sheet1")
If Date - Range("A1").Value >= 7 Then
.Range("A1").Value = Date
.Range("A1").Value = .Range("A1").Value
.Range("A2").Value = Date
ActiveWorkbook.SaveCopyAs Filename:=Path & "\Backups\" & fname & ".xlsm"
End If
End With
End Sub

 

[dpaton05]

Thanks Michael, with that code, I get the error variable not defined and the word path is highlighted in the forth last line.

 

[Michael M]

So ......what would you check in that string ???

ActiveWorkbook.SaveCopyAs Filename:=Path & "\Backups\" & fname & ".xlsm"

 

[dpaton05]

Found the problem, thanks for making me check. It needed a thisworkbook.path

Sub BackupFile()
Dim sFileName As String, fname As String, fpath As String
fpath = ThisWorkbook.Path
fname = Format(Now, "dd-mm-yy hhmm AM/PM")
With Sheets("Backups")
    If Date - Range("A1").Value >= 7 Then
    .Range("A1").Value = Date
    .Range("A1").Value = .Range("A1").Value
    .Range("A2").Value = Date
    ActiveWorkbook.SaveCopyAs FileName:=ThisWorkbook.Path & "\Backups\" & fname & ".xlsm"
    End If
End With
End Sub

 

[Michael M]

No it didn't......it simply needed "Path" replaced with fPath !
3rd line of the code !

Remeber...."Teach a man to fish"