title: Access/ Excel integration:How to avoid conflicts between simultaneous users?
body: <p>I'm developing an excel tool which connects to an Access database through VBA, and data is transferred between excel and the DB upon user requests. Each user have his own version of the excel workbook, which connects to the central db. In most cases this works fine, but i have discovered some conflicts when two users are trying to connect at the same time, causing one of the users excel/VBA to crash without any VBA errorcode. </p>
  
  <p>I suspect this is caused by the database the connection somehow being interrupted by the second user. </p>
  
  <p>So my question is: 
  Is there a way to "lock" the connection when the first user has connected and then knowing the db is in use when the second user tries to connect, so his request can be aborted/delayed, without excel crashing? </p>
  
  <p>I have included the code for one of the transactions, which moves data from excel to the database. </p>
  
  <pre class="lang-vb prettyprint-override"><code>Public Sub ExportToAccess()
  
  ''''Establish connection to DB
  Set cn = New ADODB.Connection
  cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" &amp; dbPath &amp; ";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 = '" &amp; NamesArea(area) &amp; "'" _
              &amp; " AND Week = '" &amp; week &amp; "'" _
              &amp; " AND AreaWeekID = '" &amp; i &amp; "'"
  
          If rstDbTable.EOF Then 'Check if its empty and then create new records
              MsgBox ("Could not find row in DB. Script is ending. CapArea =" &amp; NamesArea(area) &amp; ". AreaWeekId = " &amp; 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
  
  </code></pre>