I am receiving the following error:
Microsoft Visual Basic
Run-Time error '2147467259 (80004005)':
The microsoft jet database engine cannot open the file. It is already opened exclusively by another user, or you need permission to view its data.
This is the code I am using, the following is assigned to a button which should send data through to an access table, however works for me, but when other users try it they get the above message ?
Sub ADOFromExcelToA ccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connectio n, rs As ADODB.Recordset , r As Long
' connect to the Access database
Set cn = New ADODB.Connectio n
cn.Open "Provider=Micro soft.Jet.OLEDB. 4.0; " & _
"Data Source=S:\Real Time Data\Sales.mdb; "
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "Table2", cn, adOpenKeyset, adLockOptimisti c, adCmdTable
' all records in a table
r = 1 ' the start row in the worksheet
Do While Len(Range("B" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("Person nel No") = Range("B" & r).Value
.Fields("Date / Time") = Range("C" & r).Value
.Fields("Produc t") = Range("D" & r).Value
.Fields("Qte") = Range("E" & r).Value
.Fields("Pol / Qte No") = Range("F" & r).Value
.Fields("B") = Range("G" & r).Value
.Fields("C") = Range("H" & r).Value
.Fields("ADB") = Range("I" & r).Value
.Fields("ADC") = Range("J" & r).Value
.Fields("PP") = Range("K" & r).Value
.Fields("HE") = Range("L" & r).Value
.Fields("LEG") = Range("M" & r).Value
.Fields("NA(NOI SE)") = Range("N" & r).Value
.Fields("TRM4") = Range("O" & r).Value
.Fields("TRAVEL ONLY") = Range("P" & r).Value
.Fields("Outcom e") = Range("Q" & r).Value
.Fields("Call Source") = Range("R" & r).Value
.Fields("Call Outcome") = Range("S" & r).Value
.Fields("Our Price") = Range("T" & r).Value
.Fields("Comp Price") = Range("U" & r).Value
.Fields("Comp Name") = Range("V" & r).Value
.Fields("Time") = Range("W" & r).Value
' add more fields if necessary...
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
Microsoft Visual Basic
Run-Time error '2147467259 (80004005)':
The microsoft jet database engine cannot open the file. It is already opened exclusively by another user, or you need permission to view its data.
This is the code I am using, the following is assigned to a button which should send data through to an access table, however works for me, but when other users try it they get the above message ?
Sub ADOFromExcelToA ccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connectio n, rs As ADODB.Recordset , r As Long
' connect to the Access database
Set cn = New ADODB.Connectio n
cn.Open "Provider=Micro soft.Jet.OLEDB. 4.0; " & _
"Data Source=S:\Real Time Data\Sales.mdb; "
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "Table2", cn, adOpenKeyset, adLockOptimisti c, adCmdTable
' all records in a table
r = 1 ' the start row in the worksheet
Do While Len(Range("B" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("Person nel No") = Range("B" & r).Value
.Fields("Date / Time") = Range("C" & r).Value
.Fields("Produc t") = Range("D" & r).Value
.Fields("Qte") = Range("E" & r).Value
.Fields("Pol / Qte No") = Range("F" & r).Value
.Fields("B") = Range("G" & r).Value
.Fields("C") = Range("H" & r).Value
.Fields("ADB") = Range("I" & r).Value
.Fields("ADC") = Range("J" & r).Value
.Fields("PP") = Range("K" & r).Value
.Fields("HE") = Range("L" & r).Value
.Fields("LEG") = Range("M" & r).Value
.Fields("NA(NOI SE)") = Range("N" & r).Value
.Fields("TRM4") = Range("O" & r).Value
.Fields("TRAVEL ONLY") = Range("P" & r).Value
.Fields("Outcom e") = Range("Q" & r).Value
.Fields("Call Source") = Range("R" & r).Value
.Fields("Call Outcome") = Range("S" & r).Value
.Fields("Our Price") = Range("T" & r).Value
.Fields("Comp Price") = Range("U" & r).Value
.Fields("Comp Name") = Range("V" & r).Value
.Fields("Time") = Range("W" & r).Value
' add more fields if necessary...
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing