数据库意外关闭时使用 DAO 句柄时出现问题

Question

我正在使用 DAO 句柄（在下面的代码中表示）来提高我的 Access 数据库的速度和性能，该数据库位于共享网络上并且速度非常慢。下面的代码是一位专家提供给我的，以帮助数据库提高速度和性能。如您所见，数据库在打开时打开句柄 (OpenAllDatabases True)，然后在关闭数据库时关闭句柄 (OpenAllDatabases False)。

我的问题是在数据库意外关闭时出现的。发生这种情况时，我会被告知我无法再进入数据库的编辑模式，因为它已被另一个用户打开。我想是这种情况，因为当数据库意外关闭时 'OpenAllDatabases' 被设置为 TRUE。发生这种情况时，我被迫以独占方式打开数据库，只停用代码，关闭并重新打开数据库，然后重建代码。这对我来说是相当冒险的，特别是因为有多个用户使用该工具。下面是我的代码：

在主窗体上：

Form_Load()
  OpenAllDatabases True
End Sub

关于关闭数据库的命令按钮：

Private Sub cmdCloseDatabase_Click()
  OpenAllDatabases False
End Sub

模块

Sub OpenAllDatabases(pfInit As Boolean)
    ' Open a handle to all databases and keep it open during the entire time the application runs.
    ' Params  : pfInit   TRUE to initialize (call when application starts)
    '                    FALSE to close (call when application ends)
    ' Source  : Total Visual SourceBook

    Dim x As Integer
    Dim strName As String
    Dim strMsg As String

    ' Maximum number of back end databases to link
    Const cintMaxDatabases As Integer = 2

    ' List of databases kept in a static array so we can close them later
    Static dbsOpen() As DAO.Database

    If pfInit Then
        ReDim dbsOpen(1 To cintMaxDatabases)
        For x = 1 To cintMaxDatabases
            ' Specify your back end databases
            Select Case x
                Case 1:
                    strname="S:\Apps\PRESTO\BE.accdb"
            End Select
            strMsg = ""

    On Error Resume Next
            Set dbsOpen(x) = OpenDatabase(strName)
            If Err.Number > 0 Then
                strMsg = "Trouble opening database: " & strName & vbCrLf & _
                         "Make sure the drive is available." & vbCrLf & _
                         "Error: " & Err.Description & " (" & Err.Number & ")"
            End If

    On Error GoTo 0
            If strMsg <> "" Then
                MsgBox strMsg
                Exit For
            End If
        Next x
    Else
    On Error Resume Next
        For x = 1 To cintMaxDatabases
            dbsOpen(x).Close
        Next x
    End If
End Sub

Answer 1

在 Sub OpenAllDatabases 中，我发现这两行有问题：

Const cintMaxDatabases As Integer = 2
' ...
For x = 1 To cintMaxDatabases
    Select Case x
        Case 1:
            strname="S:\Apps\PRESTO\BE.accdb"
    End Select

您正在经历两次循环，但只设置了一次数据库路径。如果您遵循您的代码，您将与 "S:\Apps\PRESTO\BE.accdb".

建立两个连接

修复此错误，以便您只建立一个连接，然后查看问题是否消失。

Answer 2

好的，感谢您解决该问题。

我使用类似的代码，一直有效。我一直在将您的代码与我的代码进行比较，并试图思考它们之间的区别。

接下来我想让您尝试的是更改此行：

Set dbsOpen(x) = OpenDatabase(strName)

收件人：

Set dbsOpen(x) = OpenDatabase(strName, ReadOnly:=True)

在我的快速测试中，这仍然会提高应用程序的性能，并且您的表单仍然可以写入后端数据。

这样，OpenAllDatabases 就无法在您的后端数据库上获得写锁。看看这是否能解决您的前端意外关闭时的问题。

数据库意外关闭时使用 DAO 句柄时出现问题

Issue when using a DAO handle when the database closes unexpectedly

ms-access

vba

ms-access-2010

dao