无法更新;目前锁定。 （VB6和MS Access）

Question

我收到错误＆＃34;无法更新;目前已锁定。＆＃34;当两个或多个用户几乎同时在两个不同的MS Access数据库文件中插入记录时。似乎正在发生的事情是运行代码的第二个副本会导致两个数据库最终同时被锁定，并且每个程序都在等待另一个程序释放它所插入的表上的锁。因此，程序的第一个实例进入错误陷阱，等待Logs.accdb解锁，以便它可以插入到Logs表中，程序的第二个实例进入错误陷阱，等待Data.accdb解锁所以它可以插入到Transactions表中。我们常常有多台计算机运行多个exes。每个exe都有两个连接，每个连接一个数据库。这种配置绝对不能改变。

生产代码使用了更为复杂（并且组织得更好）的代码，但我已将其降低到最低限度，以验证代码复杂性不是问题。我创建了一个可以重新创建错误的测试程序，除了将CursorLocation从adUseServer切换到adUseClient之外，我们无法找出任何阻止​​错误发生的方法。这种解决方案是不可接受的，因为执行查询所需的时间急剧增加。

我尝试过的并没有阻止错误的事情：

• 每次插入后关闭连接。 （除了不解决问题之外，这也导致执行时间的急剧增加。）
• 检测到错误并尝试恢复时关闭所有连接。
• CursorTypes的每个排列。
• 替换SQL Execute的ADODB RecordSet Update方法（INSERT INTO ...）。
• 将Access 2003数据库转换为Access 2013并将Jet 4.0切换为Jet Ace 12。
• 为数据库创建前端。 （数据库通常驻留在没有前端的网络共享上。）
• 将数据库移至C：。 （我已经读过数据库的长路径会产生错误。）
• 更改Access中的客户端设置以执行基于行的锁定并将所有锁定更改为无锁定到已编辑的行。
• 编辑：在恢复之前在错误陷阱中添加延迟。

我正在寻找任何帮助来解决这个问题，而不会做出重大改变（比如切换到SQL Server，我也尝试过，也解决了问题，但也不是一个选项）。这是一个长期运营的公司的生产代码，因此很难实施重大变更（以及为什么会有这么多的要求＆＃39;）。

这是测试程序的代码。两个WriteRecord函数几乎完全相同。将此代码编译为exe并在同一台机器上运行exe的两个副本总是重新创建错误。

Option Explicit

Public oLConnection As ADODB.Connection
Public oTConnection As ADODB.Connection

Sub Main()
    Dim RecordID As Long

    On Error GoTo ErrorOccurred
    For RecordID = 1 To 100000
        DoEvents
        Transaction_WriteRecord "Joe", 40000
        Log_WriteRecord "Inserted Transaction", "Joe"
    Next 'RecordID
ErrorOccurred:
    oTConnection.Close
    Set oTConnection = Nothing
    oLConnection.Close
    Set oLConnection = Nothing
End Sub

Public Function Transaction_WriteRecord(TransAccount As String, TransDate As Long) As Boolean
    Dim rsTransaction As ADODB.Recordset
    Dim sQuery As String
    Dim TryCount As Integer
    Static RecordID As Long

    On Error GoTo ErrorOccurred

    sQuery = _
        "SELECT * " & _
        "FROM Transactions " & _
        "WHERE RecordID = 0"

    If oTConnection Is Nothing Then
        Set oTConnection = New ADODB.Connection
        oTConnection.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=Data.accdb"
        oTConnection.CursorLocation = adUseServer
        oTConnection.Open
    End If

    Set rsTransaction = New ADODB.Recordset
    rsTransaction.ActiveConnection = oTConnection
    rsTransaction.CursorType = adOpenKeyset
    rsTransaction.LockType = adLockOptimistic
    rsTransaction.Open sQuery, Options:=adCmdText

    rsTransaction.AddNew
    rsTransaction!TransAccount = TransAccount
    rsTransaction!TransDate = TransDate
    rsTransaction.Update
    RecordID = rsTransaction!RecordID.Value
    rsTransaction.Close

    Transaction_WriteRecord = True
    Exit Function

ErrorOccurred:
    'If the error is that the table is locked because another user
    'is adding or deleting records, just try again.
    If VBA.Error(Err) Like "Could not update; currently locked*" Then
        DoEvents
        TryCount = TryCount + 1
        If TryCount >= 5 Then
            MsgBox "Could not update; currently locked. " & vbCr & _
                   "Table: Transaction" & vbCr & _
                   "RecordID: " & RecordID
            Err.Raise Err.Number
        Else
            Resume
        End If
    Else
        Err.Raise Err.Number
    End If
    Transaction_WriteRecord = False
End Function

Public Function Log_WriteRecord(LogMessage As String, LogAccount As String) As Boolean
    Dim rsLog As ADODB.Recordset
    Dim sQuery As String
    Dim TryCount As Integer
    Static RecordID As Long

    On Error GoTo ErrorOccurred

    sQuery = _
        "SELECT * " & _
        "FROM Logs " & _
        "WHERE RecordID = 0"

    If oLConnection Is Nothing Then
        Set oLConnection = New ADODB.Connection
        oLConnection.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=Logs.accdb"
        oLConnection.CursorLocation = adUseServer
        oLConnection.Open
    End If

    Set rsLog = New ADODB.Recordset
    rsLog.ActiveConnection = oLConnection
    rsLog.CursorType = adOpenKeyset
    rsLog.LockType = adLockOptimistic
    rsLog.Open sQuery, Options:=adCmdText

    rsLog.AddNew
    rsLog!LogMessage = LogMessage
    rsLog!LogAccount = LogAccount
    rsLog.Update
    RecordID = rsLog!RecordID.Value
    rsLog.Close

    Log_WriteRecord = True
    Exit Function

ErrorOccurred:
    'If the error is that the table is locked because another user
    'is adding or deleting records, just try again.
    If VBA.Error(Err) Like "Could not update; currently locked*" Then
        DoEvents
        TryCount = TryCount + 1
        If TryCount >= 5 Then
            MsgBox "Could not update; currently locked. " & vbCr & _
                   "Table: Logs" & vbCr & _
                   "RecordID: " & RecordID
            Err.Raise Err.Number
        Else
            Resume
        End If
    Else
        Err.Raise Err.Number
    End If
    Log_WriteRecord = False
End Function