A reader offers another method for automatically backing up databases, one which runs every time the database starts.
In response to my update on backing up Access databases in AW 7.14, Wim Vermeer contributed his routine, which runs every time the database starts. It will make a backup folder (if it doesn’t exist) and make daily backups (Named Sunday-Monday-Saturday) which get overwritten a week later.
Private Sub subMakeBackup()
On Error GoTo ErrorHandler
Dim fs As Object
Dim strAppPath As String
Dim strAppName As String
Dim strDay As String
Dim strWeek As String
Dim strDailyBackup As String
Dim strWeeklyBackup As String
Dim boolMakeDailyBackup As Boolean
Dim boolMakeWeeklyBackup As Boolean
strAppName = Application.CurrentProject.FullName
strAppPath = Application.CurrentProject.Path strBackupPath = strAppPath & “backup”
Set fs = CreateObject(“Scripting.FileSystemObject”)
If Not (fs.FolderExists(strBackupPath)) Then fs.CreateFolder (strBackupPath)
‘Assume we have to make a daily backup
‘If backupfile exist then check if it today’s date ‘ if it is then don’t make backup
‘else delete the file
‘if we still need to make backup: copy the application ‘
boolMakeDailyBackup = True
strDay = Format(Now(), “dddd”)
strDailyBackup = strBackupPath & strDay & “.MDB”
If fs.FileExists(strDailyBackup) Then
Set f = fs.GetFile(strDailyBackup)
If f.DateCreated = Date Then
boolMakeDailyBackup = False
Else
fs.deletefile strDailyBackup
End If
End If
If boolMakeDailyBackup Then fs.copyfile strAppName, strDailyBackup
boolMakeWeeklyBackup = True
strWeek = Format(Now(), “yyyy-ww”) ‘get year + week number strWeeklyBackup = strBackupPath & strWeek & “.MDB”
If fs.FileExists(strWeeklyBackup) Then
boolMakeWeeklyBackup = False
End If
If boolMakeWeeklyBackup Then fs.copyfile strAppName, strWeeklyBackup
niceexit:
Exit Sub
ErrorHandler:
Dim strError As String
If Err.Number <> 0 Then
strError = “Error # ” & Str(Err.Number) & ” was generated by ” & Err.Source & Chr(13) & Err.Description
MsgBox strError, , “Error”, Err.HelpFile, Err.HelpContext
End If
GoTo niceexit
End Sub
