Link to home
Start Free TrialLog in
Avatar of Terry Moore
Terry Moore

asked on

Excel VBA 3709 Run-Time Error

I have create an excel table that I would like to directly export and append the data in Access.  I keep getting the Run-time error 3709, "The connection cannot be used to perform this operation.  It is either closed or invalid in this context."    This is the line that keeps causing the issue:  
rs.Open "FY18 Fee Review Mod Cost Table Data”, cn, adOpenKeyset, adLockOptimistic, adCmdTable"

Below is the total script that I have created.  Please help me!

Sub ADOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, R As Long
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "provider = Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=R:\Modular Cost Tables\FY 2018A\RCA Database Prep\Terry's Updates\FY 2018 AOP RCA Database_062717_SCOPS Locations.accdb;"
 ' open a recordset
Set rs = New ADODB.Recordset
rs.Open "FY18 Fee Review Mod Cost Table Data”, cn, adOpenKeyset, adLockOptimistic, adCmdTable"
' all records in a table
R = 2 ' the start row in the worksheet
Do While Len(Range(“A” & 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("Project_ID") = Range(“A” & R).Number
.Fields("Item") = Range(“B” & R).Text
.Fields(“Object_Class”) = Range("C" & R).Text
.Fields(“OC_Name”) = Range("D" & R).Text
.Fields("ProjectTask") = Range("E" & R).Text
.Fields("Fund") = Range("F" & R).Text
.Fields(“Prog”) = Range("G" & R).Text
.Fields(“Object”) = Range("H" & R).Text
.Fields(“FeeReviewOrgDash”) = Range("I" & R).Text
.Fields(“FeeReviewOrgName”) = Range("J" & R).Text
.Fields(“Request_Category”) = Range("K" & R).Text
.Fields("Cost_Type") = Range("L" & R).Text
.Fields(“Obj_Type”) = Range(“M” & R).Text
.Fields(“FY_2018_Total”) = Range(“N” & R).Currency
.Fields(“FY_2019_Total”) = Range(“O” & R).Currency
.Fields(“FY_2020_Total”) = Range(“P” & R).Currency
.Fields(“Locality”) = Range(“Q” & R).Text
.Fields(“Office”) = Range(“R” & R).Text
' 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
End Sub
Avatar of byundt
byundt
Flag of United States of America image
Did you use the Debug...Compile VBA Project menu item? That's a good first step when you try to identify and fix bugs in your code. This tool stops at the first error it finds. So keep running it and fixing problems until you get a clean report.

Your posted code contains a number of curly double quotes. These are not treated the same as the straight double quote characters that you need to be using. Because you did not use a code block, I cannot tell whether this is the cause of the problem in your code.

Besides using curly quotes, your rs.Open statement has three double quotes, with a curly double quote being in the middle. I would expect the double quotes to be used in pairs.

You are using early binding for the statements in the code snippet below. This means you must be adding some references so VBA can tell what the object, method and properties are for cn and rs. These references will be checked in the Tools...References menu item. Please specify which ones you used. 
Dim cn As ADODB.Connection, rs As ADODB.Recordset, R As Long
' connect to the Access database
Set cn = New ADODB.Connection

Open in new window

User generated imageFWIW, the screenshot shows the dialog you need to be looking at. The first four references are checked automatically. The remainder need to be added. Note that I am not telling you which references you need to be using. Instead, I want you to be telling me which ones you chose.

After some more checking, I believe that Microsoft ActiveX Data Objects 6.1 Library is the one I need to use on my Office 2016 laptop.

After addressing the 40 plus instances of curly quotes instead of double quotes, the following code compiles on my computer. I don't know if it works or not.
Sub ADOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, R As Long
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "provider = Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=R:\Modular Cost Tables\FY 2018A\RCA Database Prep\Terry's Updates\FY 2018 AOP RCA Database_062717_SCOPS Locations.accdb;"
 ' open a recordset
Set rs = New ADODB.Recordset
rs.Open "FY18 Fee Review Mod Cost Table Data", cn, adOpenKeyset, adLockOptimistic, adCmdTable
' all records in a table
R = 2 ' the start row in the worksheet
Do While Len(Range("A" & 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("Project_ID") = Range("A" & R).Number
        .Fields("Item") = Range("B" & R).Text
        .Fields("Object_Class") = Range("C" & R).Text
        .Fields("OC_Name") = Range("D" & R).Text
        .Fields("ProjectTask") = Range("E" & R).Text
        .Fields("Fund") = Range("F" & R).Text
        .Fields("Prog") = Range("G" & R).Text
        .Fields("Object") = Range("H" & R).Text
        .Fields("FeeReviewOrgDash") = Range("I" & R).Text
        .Fields("FeeReviewOrgName") = Range("J" & R).Text
        .Fields("Request_Category") = Range("K" & R).Text
        .Fields("Cost_Type") = Range("L" & R).Text
        .Fields("Obj_Type") = Range("M" & R).Text
        .Fields("FY_2018_Total") = Range("N" & R).Currency
        .Fields("FY_2019_Total") = Range("O" & R).Currency
        .Fields("FY_2020_Total") = Range("P" & R).Currency
        .Fields("Locality") = Range("Q" & R).Text
        .Fields("Office") = Range("R" & R).Text
        ' 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
End Sub

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of byundt
byundt
Flag of United States of America image
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Terry Moore
Terry Moore

ASKER

It worked!  Thank you so much for your help!  Below is the final code.

Sub ADOFromExYoucelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, R As Long
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "provider = Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=R:\Modular Cost Tables\FY 2018A\RCA Database Prep\Terry's Updates\FY 2018 AOP RCA Database_062717_SCOPS Locations.accdb;"
 ' open a recordset
Set rs = New ADODB.Recordset
rs.Open "[FY18 Fee Review Mod Cost Table Data]", cn, adOpenKeyset, adLockOptimistic, adCmdTable
' all records in a table
R = 2 ' the start row in the worksheet
Do While Len(Range("A" & R).Value) > 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("Project_ID") = Range("A" & R).Value
        .Fields("Item") = Range("B" & R).Text
        .Fields("Object_Class") = Range("C" & R).Text
        .Fields("OC_Name") = Range("D" & R).Text
        .Fields("ProjectTask") = Range("E" & R).Text
        .Fields("Fund") = Range("F" & R).Text
        .Fields("Prog") = Range("G" & R).Text
        .Fields("Object") = Range("H" & R).Text
        .Fields("FeeReviewOrgDash") = Range("I" & R).Text
        .Fields("FeeReviewOrgName") = Range("J" & R).Text
        .Fields("Request_Category") = Range("K" & R).Text
        .Fields("Cost_Type") = Range("L" & R).Text
        .Fields("Obj_Type") = Range("M" & R).Text
        .Fields("FY_2018_Total") = Range("N" & R).Value
        .Fields("FY_2019_Total") = Range("O" & R).Value
        .Fields("FY_2020_Total") = Range("P" & R).Value
        .Fields("Locality") = Range("Q" & R).Text
        .Fields("Office") = Range("R" & R).Text
        ' 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
MsgBox "Data has been exported into Access."
End Sub