How to deal with Excel ADO connection concurrency? - sql

Question

I made a multi-user interface on Excel to write records on a common Excel file using ADO Connection.
I have four users using this interface (different interface file for each user).
It works, until two or more users try to add or edit a record simultaneously.
When that's the case, VBA opens the Excel file in read-only mode right after it tries to open the ADO connection for the last user.
Read-only Excel file opened
My work-around try was to use an ISWORKBOOKOPEN() function to identify when concurrency occurs and then close the file, close the connection, wait a second and then try again:
Application.ScreenUpdating = False
Dim ADODBCONNECT As New ADODB.Connection
Dim RECORDSET As New ADODB.RECORDSET
Dim SQL_FILTER As String
Dim DATABASE As String
' -------- BACKUP --------
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Call oFSO.CopyFile(Range("SLITTING_DATABASE"), Range("BACKUP_FILENAME"))
' -------- ADIÇÃO DO REGISTRO --------
DATABASE = Workbooks("S41 - Deacro.xlsm").Sheets("DATA SOURCES").Range("SLITTING_DATABASE")
OPEN_CONN:
ADODBCONNECT.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source ='" & DATABASE & "';
Extended Properties='Excel 12.0'"
ADODBCONNECT.Open
If ISWORKBOOKOPEN(DATABASE) = True Then
ADODBCONNECT.Close
Workbooks(DATABASE).Close False
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 1
WAITTIME = TimeSerial(newHour, newMinute, newSecond)
Application.Wait WAITTIME
GoTo OPEN_CONN
End If
SQL_FILTER = "Select * From [SLIT_INCOME$]"
RECORDSET.Open SQL_FILTER, ADODBCONNECT, adOpenKeyset, adLockOptimistic
RECORDSET.AddNew
RECORDSET!SlittingWO = Workbooks("S41 - Deacro.xlsm").Sheets("INTERFACE").Range("OP_Corte")
RECORDSET!ReelUD = CADASTRO_DE_BOBINAS.REEL_UD_ENTRY
RECORDSET!ReelLenghtm = CADASTRO_DE_BOBINAS.REEL_MTS_IN_ENTRY
RECORDSET!Date = Now
RECORDSET.UPDATE
RECORDSET.Close
ADODBCONNECT.Close
' -------- ATUALIZAÇÃO DOS DADOS NA INTERFACE --------
Call UPDATE_DATA
Application.ScreenUpdating = True
Two other problems occur here:
1 - The workbooks.close seems not to be working when the file opens because of:
Error 9, subscript out of range
2 - If the function is used after opening the ADO connection, it returns true even when the connection has been opened by same user that is checking the file availability.
I copied the function from another question here:
Function ISWORKBOOKOPEN(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: ISWORKBOOKOPEN = False
Case 70: ISWORKBOOKOPEN = True
Case Else: Error ErrNo
End Select
End Function
Is there a way to detect that the file is being accessed through ADO connection by another user, so I can make a loop to force the last user to wait until the first user's connection is closed?
I know Excel has a lot of limitations when used as database file, but it is the only tool my company provides.

Answer 1

Work-around: created a "locking-flag" file that is opened as input and read mode is locked before the ADO connection is stablished. First user to open the file causes the second one to crash on VBA error 70, which I use to loop the second user through the attempt to open the "locking-flag" file untill the first one closes it.
Application.ScreenUpdating = False
Dim ADODBCONNECT As New ADODB.Connection
Dim RECORDSET As New ADODB.RECORDSET
Dim SQL_FILTER As String
Dim DATABASE As String
' -------- BACKUP --------
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Call oFSO.CopyFile(Range("SLITTING_DATABASE"), Range("BACKUP_FILENAME"))
' -------- BLOQUEAR BANCO DE DADOS --------
DATABASE = Workbooks("S41 - Deacro.xlsm").Sheets("DATA SOURCES").Range("SLITTING_DATABASE")
LOCKING_FLAG_FILE = Workbooks("S41 - Deacro.xlsm").Sheets("DATA SOURCES").Range("LOCKING_FLAG_FILE")
ErrNo = 0
Do
On Error Resume Next
ff = FreeFile()
Open LOCKING_FLAG_FILE For Input Lock Read As #ff
ErrNo = Err
On Error GoTo 0
Loop While ErrNo = 70
' -------- ADIÇÃO DO REGISTRO --------
ADODBCONNECT.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source ='" & DATABASE & "'; Extended Properties='Excel 12.0'"
ADODBCONNECT.Open
SQL_FILTER = "Select * From [SLIT_INCOME$]"
RECORDSET.Open SQL_FILTER, ADODBCONNECT, adOpenKeyset, adLockOptimistic
RECORDSET.AddNew
RECORDSET!SlittingWO = Workbooks("S41 - Deacro.xlsm").Sheets("INTERFACE").Range("OP_Corte")
RECORDSET!ReelUD = CADASTRO_DE_BOBINAS.REEL_UD_ENTRY
RECORDSET!ReelLenghtm = CADASTRO_DE_BOBINAS.REEL_MTS_IN_ENTRY
RECORDSET!Date = Now
RECORDSET.UPDATE
RECORDSET.Close
ADODBCONNECT.Close
' -------- DESBLOQUEAR BANCO DE DADOS --------
Close ff
' -------- ATUALIZAÇÃO DOS DADOS NA INTERFACE --------
Call UPDATE_DATA
Application.ScreenUpdating = True
It's far away from being an elegant solution, but if excel is the only tool you have, and there are not a lot of users using the interface (in this case, I only have four), this will do the job.