My Code To Backup Automatically

[ChipR]

Haven't found anything on the web to do exactly what I wanted so I thought I would share this procedure I wrote to run whenever someone starts my application:

Private Sub TryBackup()
On Error GoTo ErrorHandler
    Dim cnn As New ADODB.Connection
    Dim userRecords As New ADODB.Recordset
    Dim userCount As Integer
    Dim db As Database
    Dim records As DAO.Recordset
    Dim intFileNumber As Integer
    Dim strFileName As String
    Dim strSourceDB As String
    Dim strOldFileName As String
    Dim strFolderPath As String
    Dim strDestDB As String
    Dim strSQL As String
    
    'see how many users are connected
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" _
    & "Data Source=" & dbPath

    Set userRecords = cnn.OpenSchema(adSchemaProviderSpecific, _
    , "{947bb102-5d43-11d1-bdbf-00c04fb92675}")

    'this just created a second connection, so don't count it
    userCount = -1
    While Not userRecords.EOF
        userCount = userCount + 1
        userRecords.MoveNext
    Wend
    userRecords.Close
    Set userRecords = Nothing
    Set cnn = Nothing

    'if others are connected, can't back up
    If userCount > 1 Then
        Exit Sub
    End If

    'display Backup message
    DoCmd.OpenForm "Backup"
    'close the connection to the backend
    DoCmd.Close acForm, "ConnectForm"

    'get the next file number to overwrite
    Set db = CurrentDb()
    'BackupLog has FileNumber and BackupTime and 9 records in it to cycle through with FileNumber 1 through 9
    Set records = db.OpenRecordset("SELECT * FROM BackupLog ORDER BY BackupTime ASC;")

    If records.EOF Then
        Err.Raise 666, , "No backup filename found."
    End If

    intFileNumber = records!FileNumber
    records.Close
    Set records = Nothing
    db.Close
    Set db = Nothing

    'get the file names
    strSourceDB = dbPath 'global variable I found and set earlier
    strFolderPath = Left$(dbPath, Len(dbPath) - 15) & "Backup\"
    strFileName = "MYDB_Backup" & intFileNumber & ".accdr"
    strDestDB = strFolderPath & strFileName
    strOldFileName = strFileName & ".old"
    
    'rename the old backup file
    Name strFolderPath & strFileName As strFolderPath & strOldFileName
    
    'do the compact and repair
    If Not Application.CompactRepair(strSourceDB, strDestDB, True) Then
        Err.Raise 666, , "Unable to back up the database."
    End If
    
    'delete the old backup
    Kill strFolderPath & strOldFileName
    
    'record the time in the backup log
    strSQL = "UPDATE BackupLog SET BackupTime = #" & Now & "# WHERE FileNumber = " & intFileNumber & ";"
    DoCmd.SetWarnings False
    DoCmd.RunSQL strSQL
    DoCmd.SetWarnings True

    'reopen connection form
    DoCmd.OpenForm "ConnectForm", acNormal, , , , acHidden
    'close Backup message
    DoCmd.Close acForm, "Backup"
    
ExitCode:
    Exit Sub

ErrorHandler:
    HandleError Err.number, Err.description, Me.Name & ":TryBackup"
    Resume ExitCode
End Sub

Comments are welcome!
Some credit to Backing up an Access Database where the idea started.

[missinglinq]

Since this is not a question I've removed it from the Access Q & A forum to the Editors Corner, where it can be vetted.

You should also note that doing a Compact and Repair always carries the very real possibility of data corruption and loss! As such, a standard backup copy should always be made, on the closed file, before doing a C & R. Which kind of makes all of this moot.

Linq ;0)>

Moderator

[ChipR]

Thank you!
I am, of course, disconnecting from the backend database before the compact and repair. So should I just do a copy at that point in the code instead of the compact and repair?

[Markus]

If you want this to be seen and maybe appear on google, etc., then go back through your post and turn it into an article. Otherwise, it will just sit here and rot.

Markus.