VBA Access - backupfile once a week (1 Viewer)

Hello

Good Afternoon to all!!

I´m trying to create a command that will create a backup of my access database once every week.

here is the code I've got so far. it works, but not once a week but every time I start the access:

MsgBox ("Hello! Starting Backup procedure")

Dim DateOfBackup As Date
Dim strSourcePath As String
Dim strSourceFile As String
Dim strBackupFile As String
Dim SQL As String

Const BACKUP_PATH = "G:\Sales\101-Project\backup\old "


DateOfBackup = Nz(DLookup("BkupDate", "Bkup_ctrl", "BkupDate=date()"), 0)
If DateOfBackup = Date Then
MsgBox ("Already existing a backup of this day")
End
End If

strSourcePath = GetFileName(CurrentDb.Name, False)
strSourceFile = GetFileName(CurrentDb.Name, True)
strBackupFile = "DB-" & Format(Date, "mm-dd-yyyy") _
& "_" & Format(Time, "hhmmss") & "-" & strSourceFile
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile strSourcePath & strSourceFile, BACKUP_PATH & strBackupFile, True
Set fso = Nothing
DoCmd.SetWarnings False

SQL = "INSERT INTO BKup_CTrl " _
& "(BkupDate, Workstation, BackupFolder, Filename) " _
& "VALUES ('" & Date & "', '" & Environ("COMPUTERNAME") _
& "', '" & BACKUP_PATH & "', '" & strBackupFile & "');"
DoCmd.RunSQL SQL
SQL = "DELETE * FROM Bkup_ctrl WHERE BkupDate < date() - 30;"
DoCmd.RunSQL SQL
DoCmd.SetWarnings True
MsgBox ("Backup Complete - Goodbye!")
End Sub


So, in order to do what I pretend I created:

Dim TotalDate As Date

TotalDate = (Date - DateOfBackup)


and made some changes in this part of the code:

If TotalDate < 7 Then
MsgBox ("Already existing a backup of this week")
MsgBox ("Actual Date" & Date)
MsgBox (DateOfBackup)

DoCmd.OpenForm ("Start")
End
End If




This is how it looks:


Public Sub Form_Load()

MsgBox ("Hello! Starting Backup procedure")

Dim DateOfBackup As Date
Dim strSourcePath As String
Dim strSourceFile As String
Dim strBackupFile As String
Dim SQL As String
Dim TotalDate As Date
Const BACKUP_PATH = "G:\2-Sales\101-Project\backup\old "


TotalDate = (Date - DateOfBackup)
DateOfBackup = Nz(DLookup("BkupDate", "Bkup_ctrl", "BkupDate=date()"), 0)
If TotalDate < 7 Then
MsgBox ("Already existing a backup of this week")
MsgBox ("Actual Date" & Date)
MsgBox (DateOfBackup)

DoCmd.OpenForm ("Start")
End
End If

strSourcePath = GetFileName(CurrentDb.Name, False)
strSourceFile = GetFileName(CurrentDb.Name, True)
strBackupFile = "DB-" & Format(Date, "mm-dd-yyyy") _
& "_" & Format(Time, "hhmmss") & "-" & strSourceFile
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile strSourcePath & strSourceFile, BACKUP_PATH & strBackupFile, True
Set fso = Nothing
DoCmd.SetWarnings False

SQL = "INSERT INTO BKup_CTrl " _
& "(BkupDate, Workstation, BackupFolder, Filename) " _
& "VALUES ('" & Date & "', '" & Environ("COMPUTERNAME") _
& "', '" & BACKUP_PATH & "', '" & strBackupFile & "');"
DoCmd.RunSQL SQL
SQL = "DELETE * FROM Bkup_ctrl WHERE BkupDate < date() - 30;"
DoCmd.RunSQL SQL
DoCmd.SetWarnings True
MsgBox ("Backup Complete - Goodbye!")

End Sub




Can some one help me with this?

Thanks

I would recommend creating a separate "Maintenance" database that has this code in it. Then create a scheduled task through windows to open the database.

You would need to create an AutoExec macro to run your code on open.

I would just do a manual copy in windows

In a work environment, it ought to be backed up as part of your normal daily backup strategy, anyway.