Exporting data to ms access for simultaneous multi user (1 Viewer)

[WIL]

Hi Im making a Excel Form in which my Database is an access.

First I Encode data in Excel then Using Command Button to Post these data.

The code within the Command Button.. first get the Max Number from Access and use that Number to Complete the Data in Excel to be exported to Access. The Problem is If I use 3 and above users to simultaneously Post it will consolidate all the data into one with the same Number. Below is my Code

Sub ImportJEData()

Dim cnn As ADODB.Connection 'dim the ADO collection class
Dim rst As ADODB.Recordset 'dim the ADO recordset class
Dim dbPath
Dim x As Long, i As Long
Dim nextrow As Long
Dim Var

'add error handling
On Error GoTo errHandler:

'Variables for file path and last row of data
dbPath = Sheets("Update Version").Range("b1").Value
Set Var = Sheets("JE FORM").Range("F14")
nextrow = Sheets("LEDGERTEMPFORM").Cells(Rows.Count - 5, 1).End(xlUp).Row

'Initialise the collection class variable
Set cnn = New ADODB.Connection

'Create the ADODB recordset object. for Max Number
Set rst = New ADODB.Recordset 'assign memory to the recordset
LockType = adLockPessimistic

Do While IsRecordBusy = True
Application.Wait (Now + TimeValue("0:00:01") / 1000)
Loop

rst.Open SQL, cnn

SQL = "SELECT distinct Max(DVNumber),Max(ChckID) FROM DV "

Sheets("Max").Range("A2").CopyFromRecordset rst

rst.Close

'ADO library is equipped with a class named Recordset
Set rst = New ADODB.Recordset 'assign memory to the recordset

'ConnectionString Open '—-5 aguments—-
'Source, ActiveConnection, CursorType, LockType, Options
rst.Open Source:="DV", ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
Options:=adCmdTable

On Error Resume Next

cnn.Execute "Delete * FROM DV WHERE DvNumber = " & Var & ""


'you now have the recordset object
'add the values to it
For x = 7 To nextrow
rst.AddNew
For i = 1 To 37
rst(Sheets("LEDGERTEMPFORM").Cells(6, i).Value) = Sheets("LEDGERTEMPFORM").Cells(x, i).Value
Next i
rst.Update
Next x

'close the recordset
rst.Close
' Close the connection
cnn.Close
'clear memory
Set rst = Nothing
Set cnn = Nothing


'Update the sheet
Application.ScreenUpdating = True

'Clear the data
On Error GoTo 0
Exit Sub
errHandler:

'clear memory
Set rst = Nothing
Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Export_Data"

End Sub

 

[isladogs]

Post was moderated. Now approved.
I've added code tags (# on toolbar) to make it easier to read.

I'll leave this for someone else to answer. Good luck

 

[Guus2005]

First i would switch these two lines:

rst.Open SQL, cnn

SQL = "SELECT distinct Max(DVNumber),Max(ChckID) FROM DV "

And start your module with

option explicit

, then compile.

HTH

 

[WIL]

First i would switch these two lines:

rst.Open SQL, cnn

SQL = "SELECT distinct Max(DVNumber),Max(ChckID) FROM DV "

And start your module with

option explicit

, then compile.

HTH

True sorry for that, And Thank You

I wander if Setting Recordset To nothing rather than closing it will trigger the code Isrecordbusy.

Seems Like I close Recordset Twice that is why It cant go beyond 3 users.

 

[WIL]

IsRecordBusy wont work Even if Setting Recordset to Nothing.

Here below is my code still its only up to 2 simultaneous Multi Users.

Option Explicit

Sub ImportJEData()

Dim cnn As ADODB.Connection 'dim the ADO collection class
Dim rst As ADODB.Recordset 'dim the ADO recordset class
Dim dbPath
Dim x As Long, i As Long
Dim nextrow As Long
Dim Var
Dim LockType
Dim SQL
Dim IsRecordBusy


'add error handling
On Error GoTo errHandler:

'Variables for file path and last row of data
dbPath = Sheets("Update Version").Range("b1").Value
Set Var = Sheets("JE FORM").Range("F14")
nextrow = Sheets("LEDGERTEMPFORM").Cells(Rows.Count - 5, 1).End(xlUp).Row

'Initialise the collection class variable
Set cnn = New ADODB.Connection

'Create the ADODB recordset object. for Max Number
Set rst = New ADODB.Recordset 'assign memory to the recordset
LockType = adLockPessimistic

Do While IsRecordBusy = True
Application.Wait (Now + TimeValue("0:00:01") / 1000)
Loop

SQL = "SELECT distinct Max(DVNumber),Max(ChckID) FROM DV "

rst.Open SQL, cnn

Sheets("Max").Range("A2").CopyFromRecordset rst

Set rst = Nothing

Set rst = New ADODB.Recordset 'assign memory to the recordset

rst.Open Source:="DV", ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, LockType:=adLockPessimistic, _
Options:=adCmdTable

On Error Resume Next

'you now have the recordset object
'add the values to it
For x = 7 To nextrow
rst.AddNew
For i = 1 To 37
rst(Sheets("LEDGERTEMPFORM").Cells(6, i).Value) = Sheets("LEDGERTEMPFORM").Cells(x, i).Value
Next i
rst.Update
Next x

'close the recordset
rst.Close
' Close the connection
cnn.Close
'clear memory
Set rst = Nothing
Set cnn = Nothing


'Update the sheet



Application.ScreenUpdating = True

'Clear the data
On Error GoTo 0
Exit Sub
errHandler:

'clear memory
Set rst = Nothing
Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Export_Data"

End Sub