Updating Access db from Excel_adOpenKeyset Issue!

[LevelThought]

Trying to update records in an Access db by "pushing" the data from Excel using the code below. Haven't had much success at all! I keep receiving an error dialog box that states "Compile Error: Can't find project or library" and the word "adOpenKeySet" is highlighted in my code.

Currently, I have references within Access to the following:

Visual Basic For Applications
Microsoft Excel 11.0 Object Library
OLE Automation
Microsoft Office 11.0 Object Library
Microsoft ActiveX DataObjects 2.5 Library

Any idea as to what I am doing/ or not doing that is causing the problem?


The script is below:

Sub CompleteDataToAccess()
' exports data from the active worksheet to a table in an Access database
Dim ADOC As New ADODB.Connection
Dim DBS As New ADODB.Recordset
ADOC.Open "Provider=Microsoft.Jet.oledb.4.0;" & _
"Data Source=C:\Access Databases\TestAccessDatabase.mdb;"
' open a recordset
DBS.Open "tblVarianceRpt", ADOC, adOpenKeyset, adLockOptimistic, adCmdTable
Sheets("Data").Activate
Range("A2").Select
On Error GoTo CompleteDataToAccess_err
Do Until ActiveCell.Value = ""
'repeat until first empty cell in column A
With DBS
strSQL = "select * from tblVarianceRpt where AcctNo='" & ActiveCell.Range("Acct") & "'"

On Error Resume Next
.Open strSQL, cn, adOpenKeyset, adLockOptimistic, adCmdText
On Error GoTo 0
If .State = adStateOpen Then ' successfully opened the recordset
If .EOF Then ' no records returned
DBS.AddNew ' create a new record
DBS!Acct_Orig = ActiveCell.Value
DBS!Acct_Current = ActiveCell.Offset(0, 1).Value
.
.
.
DBS!DateCreated = Now()
DBS.Update ' stores the new record
ActiveCell.Offset(1, 0).Select

Else ' one (or more records returned)
' edit existing record
DBS!AccountID_Current = ActiveCell.Offset(0, 1).Value
DBS!TotChgCurrent = ActiveCell.Offset(0, 9).Value
DBS!ExpPymtCurrent = ActiveCell.Offset(0, 11).Value
.
.
.
DBS!DateUpdated = Now()
DBS.Update ' stores the new record
ActiveCell.Offset(1, 0).Select
End If
End If
End With
Loop
CompleteDataToAccess_exit:
DBS.Close ' close the recordset
ADOC.Close
Set ADOC = Nothing
Set DBS = Nothing
Exit Sub
CompleteDataToAccess_err:
MsgBox "Sorry - an error occurred..." & vbCrLf & "Number: " & Err.Number & _
vbCrLf & "Description: " & Err.Description
Resume CompleteDataToAccess_exit
End Sub

 

[TCARPENTER]

Hi LevelThought,

If you haven't figured out your problem yet, I have a few things that may help:

First this line:

' open a recordset
DBS.Open "tblVarianceRpt", ADOC, adOpenKeyset, adLockOptimistic, adCmdTable

doesn't seem to be necessary, it doesn't appear you are doing anything with it, and your error may be coming from this since in your loop below, you are reopening the recordset without first closing it.

The second thing, again, you'll need to close your recordset before reopening it with your new criteria in your SQL statement in your loop:

End With
DBS.Close ' close the recordset
Loop

HTH
Todd