antediluvian
New Member
- Joined
- Nov 9, 2016
- Messages
- 1
So little background, I have an excel userform that my end users interact with. This form pulls and pushes data to and from Access databases. The trouble I am running into is that when I have several users on and they are pulling records at the same time, often they will pull matching records. This appears to happen when two users attempt to pull their next record at very near the same time. I need the function to prevent another user from pulling the same record. I thought the solution would be to immediately delete the record after copying it, but in practice we are still getting several duplication occurrences daily.
Below is the beginning of the code, the issue seems to be contained inside the if statement. Sometimes a user will get a lock error saying that the access file is locked. If they just debug and push it through it will finish running the code a moment later, but often they will have a duplicate record with another user.
The if statement has several iterations depending on time of day the SQL code changes slightly. but the duplicates seem to be stemming from here. Any assistance would be very much appreciated. Thank You.
Below is the beginning of the code, the issue seems to be contained inside the if statement. Sometimes a user will get a lock error saying that the access file is locked. If they just debug and push it through it will finish running the code a moment later, but often they will have a duplicate record with another user.
Code:
Dim strMyPath As String, strDBName As String, strDB As String, strSQL As String
Dim i As Long, Time1 As Integer, lastrow As Long, n As Long, lFieldCount As Long
Dim rng As Range
Dim adoRecSet As New ADODB.Recordset
Dim connDB As New ADODB.Connection
Dim ws As Worksheet
strDBName = "ACTML.accdb"
strMyPath = ThisWorkbook.Path
strDB = strMyPath & "\DataFilesAdminOnly\" & strDBName
'Connect to a data source:
connDB.Open ConnectionString:="Provider = Microsoft.ACE.OLEDB.12.0; data source=" & strDB & ";Persist Security Info=False;jet oledb:Database Password= XXXXXXXXXX ;"
'set the worksheet:
Set ws = ActiveWorkbook.Sheets("Data")
'Set the ADO Recordset object:
Set adoRecSet = New ADODB.Recordset
strTable = "Data"
Time1 = Hour(Now())
If Time1 > 10 And Time1 < 19 Then
strSQL = "SELECT TOP 1 * FROM Data"
adoRecSet.Open strSQL, connDB, adOpenStatic, adLockOptimistic
Set rng = ws.Range("A1")
rng.Offset(1, 0).CopyFromRecordset adoRecSet
connDB.Execute "DELETE FROM (SELECT TOP 1 * FROM Data)"
adoRecSet.Close
Else:
The if statement has several iterations depending on time of day the SQL code changes slightly. but the duplicates seem to be stemming from here. Any assistance would be very much appreciated. Thank You.