Help needed Adding, Updating Records on Database through Network.

[VISHAL120]

Hi,

Am actually working on a project which is updating records on a MS Access database from Excel (VBA).
The project will be place on a network and will be available to around 20 users.
10 of these users will be Adding / Updating records to the database and the others will be ONLY updating the dates, comments, etc.

The Data normally are entered on the Worksheet and varies from 1 to several records at a time. Sometime 1 user can add only 1 record and others can add up to 10- 20 records at a time ( Like batch processing) depending on how many orders are being added.

Till now I have been testing same on my PC only as was still on the development and has not got problem of Adding or Updating.

But when i have tested it on the network i got Run time error like " Could not use " file already in use. I guess its the way the connection are being opened to exclusive. I am stuck with this since long and still searching solution for this, where several users can Add or Updates.


Am Attaching the Ms Access database and also below the codes being use to open ,ADD / Update.

Many thanks in advance for helping and guidance as i really need a helpful hand here to make this functional.

Codes to open connection as follows :


Public DBS As ADODB.Connection
Global RST As ADODB.Recordset
'Dim db As ADODB

Sub Connection_Open()

Set DBS = New ADODB.Connection
Set RST = New ADODB.Recordset

With DBS
.Provider = "Microsoft.ACE.OLEDB.12.0"
.CursorLocation = adUseClient
.ConnectionString = "C:\Karina_Int\Sample_Planning\Database\Sample_Process.accdb"
.Open
End With

End Sub

Sub Connection_Close()

If CBool(RST.State And adStateOpen) = True Then RST.Close
Set RST = Nothing
If CBool(DBS.State And adStateOpen) = True Then DBS.Close
Set DBS = Nothing


End Sub

Codes for add and update records:


Sub Upload_Marketing_Records_to_Database()


Application.ScreenUpdating = False ' Prevents screen refreshing.

Dim fld As ADODB.Field
Dim MyConn
Dim lngRow As Long
Dim lngId, LR, Upd
Dim j As Long
Dim ssql As String

Call set_filter_off
'clear actual data from file


LR = Range("A" & Rows.Count).End(xlUp).Row
Upd = LR - 1

Call Connection_Open

'set counter time
start_time = Time

lngRow = 11
Do While lngRow <= LR

Sheets("Marketing").Activate
lngId = Cells(lngRow, 1).Value



ssql = "SELECT * FROM Tbl_Sample_details WHERE Sample_Auto_ref = '" & lngId & "'"

Set RST = New ADODB.Recordset
RST.CursorLocation = adUseServer
RST.Open ssql, ActiveConnection:=DBS, _
CursorType:=adOpenKeyset, LockType:=adLockOptimistic

With RST
'If Not (.BOF And .EOF) = True Then
If .RecordCount = 0 Then
.AddNew
.Fields("Sample_Auto_ref") = Cells(lngRow, 1).Value
.Fields("Marketing_Manager") = Cells(lngRow, 2).Value
.Fields("Merchandiser") = Cells(lngRow, 3).Value
.Fields("Saison") = Cells(lngRow, 4).Value
.Fields("Client") = Cells(lngRow, 5).Value
.Fields("Ref_Client") = Cells(lngRow, 6).Value
.Fields("Ref_Karina") = Cells(lngRow, 7).Value
.Fields("Depart") = Cells(lngRow, 8).Value
.Fields("Theme") = Cells(lngRow, 9).Value
.Fields("Desc") = Cells(lngRow, 10).Value
.Fields("Type_Echantillion") = Cells(lngRow, 11).Value
.Fields("Taille") = Cells(lngRow, 12).Value
.Fields("Qty") = Cells(lngRow, 13).Value
.Fields("Keep_KI") = Cells(lngRow, 14).Value
.Fields("Type_Lavage") = Cells(lngRow, 15).Value
.Fields("Colori_Gmt_dyed") = Cells(lngRow, 16).Value
.Fields("Valeur_Ajouter") = Cells(lngRow, 17).Value
.Fields("Date_request_Merc") = Cells(lngRow, 18).Value

.Fields("Date_Livraison_Ech") = Cells(lngRow, 19).Value
.Fields("Date_Liv_Reviser") = Cells(lngRow, 20).Value
.Fields("Comm_Merc") = Cells(lngRow, 21).Value ' NOW FABRIC
.Fields("Comm_Client") = Cells(lngRow, 22).Value ' NOW ACCESSORIES
.Fields("PendIng_Rel") = Cells(lngRow, 23).Value
' .Fields("Date_Envoyer_Client") = Cells(lngRow, 24).Value
' .Fields("Courier_No") = Cells(lngRow, 25).Value
.Fields("Week_Number") = Cells(lngRow, 24).Value
.Fields("Month_Number") = Cells(lngRow, 25).Value
.Fields("Year_Control") = Cells(lngRow, 26).Value
.Fields("New_Order_Control") = Cells(lngRow, 27).Value


.Update
'MsgBox "record added new"
Else

.Fields("Sample_Auto_ref") = Cells(lngRow, 1).Value
.Fields("Marketing_Manager") = Cells(lngRow, 2).Value
.Fields("Merchandiser") = Cells(lngRow, 3).Value
.Fields("Saison") = Cells(lngRow, 4).Value
.Fields("Client") = Cells(lngRow, 5).Value
.Fields("Ref_Client") = Cells(lngRow, 6).Value
.Fields("Ref_Karina") = Cells(lngRow, 7).Value
.Fields("Depart") = Cells(lngRow, 8).Value
.Fields("Theme") = Cells(lngRow, 9).Value
.Fields("Desc") = Cells(lngRow, 10).Value
.Fields("Type_Echantillion") = Cells(lngRow, 11).Value
.Fields("Taille") = Cells(lngRow, 12).Value
.Fields("Qty") = Cells(lngRow, 13).Value
.Fields("Keep_KI") = Cells(lngRow, 14).Value
.Fields("Type_Lavage") = Cells(lngRow, 15).Value
.Fields("Colori_Gmt_dyed") = Cells(lngRow, 16).Value
.Fields("Valeur_Ajouter") = Cells(lngRow, 17).Value
.Fields("Date_request_Merc") = Cells(lngRow, 18).Value

.Fields("Date_Livraison_Ech") = Cells(lngRow, 19).Value
.Fields("Date_Liv_Reviser") = Cells(lngRow, 20).Value
.Fields("Comm_Merc") = Cells(lngRow, 21).Value ' NOW FABRIC
.Fields("Comm_Client") = Cells(lngRow, 22).Value ' NOW ACCESSORIES
.Fields("PendIng_Rel") = Cells(lngRow, 23).Value
' .Fields("Date_Envoyer_Client") = Cells(lngRow, 24).Value
' .Fields("Courier_No") = Cells(lngRow, 25).Value
.Fields("Week_Number") = Cells(lngRow, 24).Value
.Fields("Month_Number") = Cells(lngRow, 25).Value
.Fields("Year_Control") = Cells(lngRow, 26).Value
.Fields("New_Order_Control") = Cells(lngRow, 27).Value

RST.Update



'MsgBox "update me"
End If
End With


lngRow = lngRow + 1

Loop
'rst.Close 'the connection
Call Connection_Close



Range("A11:AC70").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Interior.ColorIndex = xlNone
'>>>making a calculation on the end time and start time

Call Set_Filter_on
End_Time = Time
Time_String = Format(End_Time - start_time, "ss")

'& Time_String & " secs"
'MsgBox "Data updated " & Upd & " records in " & Time_String & " secs"
Application.StatusBar = "Marketing Sample Data " & Upd & " Rows Updated in " & Time_String & " secs"
MsgBox "Records Save Successfully", vbInformation, "Sample Processing"
Application.ScreenUpdating = True

End Sub

[VISHAL120]

Hi everybody,

Any guidance will be of great help please.

[mancubus]

so your requirement is not about updating an access database but about receiving "could not use file; already in use" warning when trying to connect to.


The problem usually happens when the 1st file has locked the database and the 2nd file is trying to access it.


afaik and as the quoted says, first connection must be closed.

open related .ldb (Access 2003 and prior) or .laccdb (Access 2007 and later) file with Word in order to display the network id of the connected computer / user.

[VISHAL120]

Hi mancubus,

thanks for the reply in fact my problem is we are unable to update the database as its already locked by another user when tested on network. That's the biggest issue am having with the project.


I have not understand
"afaik and as the quoted says, first connection must be closed.

open related .ldb (Access 2003 and prior) or .laccdb (Access 2007 and later) file with Word in order to display the network id of the connected computer / user."

[mancubus]

that means;
- only one connection at a time.
- if you want to learn who is in the database open its ldb / laccdb (same file name with mdb / accdb) file with ms word. it is automatically created when you open a database.

afaik!!!

[VISHAL120]

Hi,

i have try to open and update for different users but still cannot. Please any help or hint will help a lot to progress further.

thanks in advance