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

Posted 2023-04-19

【中文标题】Ms Access 数据库可以在使用 vba 打开时创建自己的备份吗？

【英文标题】：Can an Ms Access database create a backup of itself while it's open using vba?

【发布时间】：2017-08-16 15:56:41

【问题描述】：

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

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

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

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

【参考方案1】：

用户“另存为”的作用与复制文件不同，它实际上创建了一个新数据库，并将所有内容导出到其中。如果您愿意（如果没有锁定的记录），您也可以这样做，但它确实需要一些编码。

如果文件被其他用户打开（并在使用时关闭所有打开的对象），则另存为菜单中的“备份数据库”不可用。

当然，您可以创建一个新文件，然后遍历所有表、查询、表单、报表、宏和模块以复制它们，然后遍历所有关系以将它们添加到副本中。然后您可以将所有数据库属性复制到新数据库。但这需要一些工作。

请参阅以下代码以创建忽略关系和数据库属性的备份

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

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

【讨论】：

我正在寻找一种方法来备份我的表格及其信息。由于您的解决方案可以做到这一点，我很感兴趣。

查看当前编辑。从未遇到过问题，但尚未进行广泛的测试

我有几个链接表，我想避免复制它们，因为它们需要打开 Quickbooks。我应该只检查 iterator.Name 表的名称以跳过这些表吗？

你不需要检查他们的名字，一个简单的If iterator.Connect <> "" Then 将排除他们。还有一个选项可以将链接表中的数据存储在备份中的未链接表中。

我对第一个条件进行了此修改：If Not iterator.Name Like "MSys*" And iterator.Connect <> "" Then，但出现错误 3709：“在任何记录中未找到搜索键。”

【参考方案2】：

您可以使用以下代码行，这是假设您有一个拆分数据库：

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

注意这不会压缩您当前的后端 (strFrom)，这会将位于 strFrom 的后端复制到新位置 (strTo)。

只要有一个按钮点击或来自另一个调用这个子的事件。

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

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

DestinationTo = C:\备份目的地

然后使用以下代码：

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

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

【讨论】：

这看起来很有希望。我尝试使用以下代码行将当前后端备份到新位置： DBEngine.CompactDatabase BackendPath("tbl"), BackendPath("tbl") & "_backup" 但是，当该代码运行时，我得到一个运行时错误“3704”：您试图打开已由计算机 Computer Name 上的用户“Admin”打开的数据库。当数据库可用时再试一次。不过，我真的希望这对我有用。

呸！我的错误，我已经编辑了我的第二个代码来解决这个问题。问题是当第一次打开 strSQL 查询的记录集时。它创建了与数据库的连接。由于存在当前连接，因此数据库无法压缩并修复到目标位置。

【参考方案3】：

您可以尝试像这样使用 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