Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

Run-Time Error 3709

0

I keep getting Run-time Error 3709 in Microsoft Visual Basic, "The connection cannot be used to perform this operation.  It is either closed or invalide in this context."  I am trying to write a macro in Microsft 2010 to ammend an Access Table in ACCESS 2010.  Below is the line that keeps causing this run-time error.

rs.Open "FY18 Fee Review Mod Cost Table Data", cn, adOpenKeyset, adLockOptimistic, adCmdTable"
Code_Goes_Here
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
excelmacros-vba
MS Office Version: 2010
posted by: terrylmoore_2017 on Wed Jul 5, 2017 at 11:10 am
Answer
Discuss

Discussion

I would venture a guess that you got the name of the tables wrong, or the Access db connection info incorrect, or your user doesn't have permissions to perform the desired actions, but I'm not an Access expert.
don (rep: 1989) Jul 9, '17 at 4:31 pm
Add to Discussion

Answers

0
Selected Answer

I finally figured it out.  It now works.

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
posted by: terrylmoore_2017 on Wed Jul 12, 2017 at 8:19 am
Discuss

Discussion

Thanks for posting the update! 
don (rep: 1989) Jul 13, '17 at 3:17 am
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login