Could not update; currently locked. (VB6 and MS Access ) - ms-access

Question

I'm getting the error "Could not update; currently locked." when two or more users insert a record in two different MS Access database files nearly simultaneously. What appears to be happening is that running a second copy of the code causes both databases to eventually become locked at the same time and each program is waiting for the other to release the locks on the table it was inserting into. So the first instance of the program goes into the error trap to wait for Logs.accdb to become unlocked so it can insert into the Logs table and the second instance of the program goes into the error trap to wait for Data.accdb to become unlocked so it can insert into the Transactions table. It is very common for us to have multiple computers running multiple exes. Each exe has two connections, one for each database. This configuration absolutely cannot be changed.
The production code uses substantially more complicated (and better organized) code, but I've reduced it down to the bare minimum to verify that code complexity wasn't the issue. I've created a test program that can recreate the error and have been unable to figure out any way to stop the error from happening other than switching the CursorLocation from adUseServer to adUseClient. This solution is unacceptable though because of the drastic increase in the time it takes to execute queries.
Things I've tried that didn't stop the error:
Closing the connection after every insert. (In addition to not fixing the issue, this also caused drastic increases in the execution time.)
Closing all connections when the error is detected and trying to Resume.
Every permutation of CursorTypes.
Replacing the ADODB RecordSet Update method for SQL Execute (INSERT INTO ...).
Converting the Access 2003 database to Access 2013 and switching Jet 4.0 to Jet Ace 12.
Creating a Front End for the database. (The databases typically reside on a network share with no Front End.)
Moving the databases to C:. (I've read that long paths to the database can generate errors.)
Changing the Client Settings within Access to do Row-based locking and changing All Locks to No Locks to Edited Rows.
Edit: Add a delay in the error trap before Resume.
I'm looking for any help at all at resolving this issue without making drastic changes (like switching to SQL Server, which I've also tried and also resolves the issue but is also not an option). This is in production code for a very long-running company, so major changes are extremely difficult to implement (and also why there's so many 'requirements').
This is the code for the test program. The two WriteRecord functions are practically identical. Compiling this code into an exe and running two copies of the exe on the same machine always recreates the error.
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