Can an Ms Access database create a backup of itself while it's open using vba?

Question

Background: I have a process that links Quickbooks to Ms Access. If a button is pressed, some information will be queried from Quickbooks and then updates M

Answer 1

The users "save as" does a different thing than just copying a file, it actually creates a new database, and exports everything to it. You can do the same if you wish (if there are no locked records), but it does require some coding.

The "backup database" is unavailable from the save as menu if the file is opened by other users (and closes all open objects when used).

You can, of course, create a new file, and then iterate through all tables, queries, forms, reports, macros and modules to copy them, and then iterate through all relationships to add them to the copy. Then you can copy all database properties to the new database. But that requires some work.

See the following code to create a backup that ignores relationships and database properties

Public Sub BackupDatabase(newLocation As String)
    'Make sure there isn't already a file with the name of the new database
    If Dir(newLocation) <> "" Then Kill newLocation
    'Create a new database using the default workspace
    'dbVersion30 = Jet 3, dbVersion40 = Jet4, dbVersion120 = 2007 accdb, dbVersion150 = 2013 accdb
    DBEngine.Workspaces(0).CreateDatabase newLocation, dbLangGeneral, Option:=dbVersion150

    'Iterate through common object collections, put the files in
    Dim iterator As Variant
    For Each iterator In CurrentDb.TableDefs
        If Not iterator.Name Like "MSys*" Then
            DoCmd.TransferDatabase acExport, "Microsoft Access", newLocation, acTable, iterator.Name, iterator.Name
        End If
    Next iterator
    For Each iterator In CurrentDb.QueryDefs
        If Not iterator.Name Like "~sq_*" Then
            DoCmd.TransferDatabase acExport, "Microsoft Access", newLocation, acQuery, iterator.Name, iterator.Name
        End If
    Next iterator
    For Each iterator In CurrentProject.AllForms
         DoCmd.TransferDatabase acExport, "Microsoft Access", newLocation, acForm, iterator.Name, iterator.Name
    Next iterator
    For Each iterator In CurrentProject.AllReports
        DoCmd.TransferDatabase acExport, "Microsoft Access", newLocation, acReport, iterator.Name, iterator.Name
    Next iterator
    For Each iterator In CurrentProject.AllMacros
        DoCmd.TransferDatabase acExport, "Microsoft Access", newLocation, acMacro, iterator.Name, iterator.Name
    Next iterator
    For Each iterator In CurrentProject.AllModules
        DoCmd.TransferDatabase acExport, "Microsoft Access", newLocation, acModule, iterator.Name, iterator.Name
    Next iterator
End Sub

Note that, depending on your security settings, you might get a lot of security popups.

Answer 2

You can try using FileSystemObject like this:

    'strFrom = Application.CurrentProject.FullName
    'strTo = "C:\FolderName\NewFileName.accdb"

Public Sub copyFile(strFrom As String, strTo As String)
    Dim fso As FileSystemObject
    Set fso = New FileSystemObject

    fso.copyFile strFrom, strTo

    Set fso = Nothing

End Sub

Answer 3

You can use the following line of code, This is assuming you have a split database:

Public Sub CompactDB()
dim strFrom as string
dim strTo as string

strFrom = "C:\Your Database Location Including File Name and Extension"
strTo = "C:\Your new Database backup location File Name and Extension"

DBEngine.CompactDatabase strFrom, strTo

End Sub

NOTE This will not compact your current backend (strFrom), This makes a copy of back end located at strFrom to the new location (strTo).

Just have a button click or event from another from call this sub.

But, the way I handle this is make a table that stores 2 fields. Field 1 is named "DestinationFrom", Field 2 is named "DestinationTo". Then I store records like below:

DestinationFrom = C:\Destination of current back end

DestinationTo = C:\Back Up destination

Then use the following code:

Public sub CompactDB()
dim rst as dao.recordset
dim strSQL as string
dim strLocation as string
Dim strDestination as string

strsql = "SELECT * " & _
         "FROM DestinationTable;"
set rst = currentdb.openrecordset(strsql)
strlocation = rst![DestinationFrom]
strdestination = rst![DestinationTo]
rst.close
set rst = nothing

DBEngine.CompactDatabase rst![DestinationFrom] , rst![DestinationTo]

if not rst is nothing then
rst.close
set rst = nothing
end if
End Sub

This way, if my code ever fails cause a folder was deleted or moved, I can change the string location in the field on the table without needing to change anything that was hard coded and needing to release a new copy. Very useful when allowing multiple users in a split database