Интеграция Access / Excel: как избежать конфликтов между пользователями одновременно?

Question

Я разрабатываю инструмент Excel, который подключается к базе данных Access через VBA, и данные передаются между Excel и БД по запросам пользователей.У каждого пользователя есть своя версия рабочей книги Excel, которая подключается к центральной базе данных.В большинстве случаев это работает нормально, но я обнаружил некоторые конфликты, когда два пользователя пытаются подключиться одновременно, в результате чего один из пользователей Excel / VBA аварийно завершает работу без кода ошибки VBA.

Я подозреваю, что это связано с тем, что база данных каким-то образом прерывает соединение со вторым пользователем.

Итак, мой вопрос: есть ли способ «заблокировать» соединение, когда первый пользователь подключился, и затем узнать, используется ли база данных, когда второй пользователь пытается подключиться, чтобы его запрос можно было прервать /отложено, без сбоев в Excel?

Я включил код для одной из транзакций, который перемещает данные из Excel в базу данных.

Public Sub ExportToAccess()

''''Establish connection to DB
Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath & ";Persist Security Info=False;"
cn.Open


Set rstDbTable = New ADODB.Recordset

With rstDbTable

    .Open "AllCapacity", cn, adOpenKeyset, adLockPessimistic, adCmdTable

End With

''''Move data''''
'one area at the time

For area = 0 To UBound(cap_areas)

    toDbArray = sh_capacity.Range(cap_areas(area)) 'Save the range in question ot the db array. starts at 1

    'MsgBox (toDbArray(1, 1))

    For i = 1 To UBound(toDbArray, 1) 'for all rows

            rstDbTable.Filter = "CapArea = '" & NamesArea(area) & "'" _
            & " AND Week = '" & week & "'" _
            & " AND AreaWeekID = '" & i & "'"

        If rstDbTable.EOF Then 'Check if its empty and then create new records
            MsgBox ("Could not find row in DB. Script is ending. CapArea =" & NamesArea(area) & ". AreaWeekId = " & i)
            Stop ' Debugger
            GoTo EndOfCode

            'rstDbTable.AddNew 'Use if we need to add new row

        Else
                'rstDbTable("AreaWeekID").Value = toDbArray(i, 27)
                'rstDbTable("Week").Value = toDbArray(i, 28)
                'rstDbTable("CapArea").Value = toDbArray(i, 29)
                'start = Timer

                rstDbTable("MO_DA").Value = toDbArray(i, 2)
               ' MsgBox (Timer - start)

                rstDbTable("MO_EV").Value = toDbArray(i, 3)
                rstDbTable("MO_NI").Value = toDbArray(i, 4)
                rstDbTable("TU_DA").Value = toDbArray(i, 5)
                rstDbTable("TU_EV").Value = toDbArray(i, 6)
                rstDbTable("TU_NI").Value = toDbArray(i, 7)
                rstDbTable("WE_DA").Value = toDbArray(i, 8)
                rstDbTable("WE_EV").Value = toDbArray(i, 9)
                rstDbTable("WE_NI").Value = toDbArray(i, 10)
                rstDbTable("TH_DA").Value = toDbArray(i, 11)
                rstDbTable("TH_EV").Value = toDbArray(i, 12)
                rstDbTable("TH_NI").Value = toDbArray(i, 13)
                rstDbTable("FR_DA").Value = toDbArray(i, 14)
                rstDbTable("FR_EV").Value = toDbArray(i, 15)
                rstDbTable("FR_NI").Value = toDbArray(i, 16)
                rstDbTable("SA_DA").Value = toDbArray(i, 17)
                rstDbTable("SA_EV").Value = toDbArray(i, 18)
                rstDbTable("SA_NI").Value = toDbArray(i, 19)
                rstDbTable("SU_DA").Value = toDbArray(i, 20)
                rstDbTable("SU_EV").Value = toDbArray(i, 21)
                rstDbTable("SU_NI").Value = toDbArray(i, 22)



        End If

        rstDbTable.Update

    Next i
Next area

EndOfCode:
rstDbTable.Close