Ms Access 数据库可以在使用 vba 打开时创建自己的备份吗？

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

提问by Jaitnium

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 Ms Access. If the power goes out, or if the user forces Ms Access to close during the sync process, it can cause some of the information to be corrupted.

背景：我有一个将 Quickbooks 链接到 Ms Access 的过程。如果按下按钮，将从 Quickbooks 查询一些信息，然后更新 Ms Access。如果停电，或者如果用户在同步过程中强制关闭 Ms Access，可能会导致某些信息被破坏。

Goal:I want to have a button on a form that users can press and it'll save the current database to a predefined location with the date and time attached to the filename.

目标：我想在用户可以按下的表单上有一个按钮，它将当前数据库保存到预定义的位置，并将日期和时间附加到文件名。

I keep reading how it's possible to backup other closeddatabases (using FileCopy), but you need a hacky-workaround solution to do it on an open database, which can lead to data corruption. I'm not entirely convinced since the user can use "Save As" at any time.

我一直在阅读如何备份其他关闭的数据库（使用 FileCopy），但是您需要一个 hacky-workaround 解决方案来在打开的数据库上执行此操作，这可能会导致数据损坏。我并不完全相信，因为用户可以随时使用“另存为”。

Is there a way to backup a currently open Ms Access database, or something that will fulfill my needs?

有没有办法备份当前打开的 Ms Access 数据库，或者可以满足我的需求？

回答by Erik A

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.

请注意，根据您的安全设置，您可能会看到很多安全弹出窗口。

回答by Chris

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

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

注意这不会压缩您当前的后端 (strFrom)，这会将位于 strFrom 的后端复制到新位置 (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:

但是，我处理这个问题的方法是制作一个存储 2 个字段的表。字段 1 命名为“DestinationFrom”，字段 2 命名为“DestinationTo”。然后我存储如下记录：

DestinationFrom = C:\Destination of current back end

DestinationFrom = C:\当前后端的目的地

DestinationTo = C:\Back Up destination

DestinationTo = C:\备份目的地

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

这样，如果我的代码失败导致文件夹被删除或移动，我可以更改表格字段中的字符串位置，而无需更改任何硬编码的内容，也无需发布新副本。在拆分数据库中允许多个用户时非常有用

回答by landrew

You can try using FileSystemObject like this:

您可以尝试像这样使用 FileSystemObject：

    '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