SQL Excel VBA Run-time Error 3709 Invalid Connection - vba

Question

This is my first question so constructive criticism is welcome! I am attempting to query an access database from excel vba and place the return information into an Excel range. I get this error:
Error Message: "Run-time error '3709' The connection cannot be used to
perform this operation. It is either closed or invalid in this
context."
Code:
Sub Importfromaccess()
Path = "C:\Users\myUser\Desktop\Database1.accdb"
Set cn = CreateObject("ADODB.connection")
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & Path & ";"
Set rs1 = CreateObject("ADODB.recordset")
rs1.activeconnection = cn
Dim strSQL As New ADODB.Command
strSQL.CommandText = "SELECT * FROM Tooling WHERE TID=BD0001"
strSQL.CommandType = adCmdText
Set rs1 = strSQL.Execute ' This is the line the error occurs on
Sheets("Calc").Range("K1").CopyFromRecordset rs1
End Sub
I have enabled the following references:
Visual Basic For Applications,
Microsoft Excel 16.0 Object Library,
OLE Automation,
Microsoft Office 16.0 Object Library,
Microsoft Access 16.0 Object Library,
Microsoft ActiveX Data Objects 2.0 Library,
I tried placing the line:
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & Path & ";"
right before the error line and received this error:
Run-time error '3705': Operation is not allowed when the object is
open.
Anybody know what my problem might be?

Answer 1

First (and unrelated to your error), unless you need to support clients using Windows 2000 or earlier, you should reference the highest Microsoft ActiveX Data Objects version instead of 2.0. If you're only using ADODB to interact with the database, you don't need the Microsoft Access 16.0 Object Library at all.
Second, if you already have a reference, don't create late bound objects like this:
Set cn = CreateObject("ADODB.connection")
Adding the reference early binds the type, so explicitly declare them and instantiate them using New:
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
Your connection string should be fine - where you run into problems are these 2 lines:
Set rs1 = CreateObject("ADODB.recordset")
rs1.activeconnection = cn
Executing an ADODB.Command will return the Recordset, not the other way around. Remove those 2 lines entirely. Instead of attaching the connection to the Recordset, you need to use it when you're building your ADODB.Command:
Dim strSQL As New ADODB.Command
strSQL.ActiveConnection = cn '<---Insert this.
strSQL.CommandText = "SELECT * FROM Table1"
strSQL.CommandType = adCmdText
Also, get rid of the Hungarian notation there - it's confusing as hell. An ADODB command isn't a String, so why should it be named strFoo?
You also need to clean up after yourself - don't leave your recordset and connection just hanging open when you're done with them. Call .Close when you're finished.
Finally, your SQL statement is most likely incorrect - you probably need to enclose your TID in single quotes('):
"SELECT * FROM Tooling WHERE TID='BD0001'"
It should look closer to this:
Sub Importfromaccess()
Dim Path As String
Path = "C:\Users\myUser\Desktop\Database1.accdb"
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & Path & ";"
Dim query As New ADODB.Command
query.ActiveConnection = cn
query.CommandText = "SELECT * FROM Tooling WHERE TID='BD0001'"
query.CommandType = adCmdText
Dim rs1 As ADODB.Recordset
Set rs1 = query.Execute ' This is the line the error occurs on
Sheets("Calc").Range("K1").CopyFromRecordset rs1
'CLEAN UP AFTER YOURSELF:
rs1.Close
cn.Close
End Sub

Answer 2

You already Set rs1
How about trying something more like:
Sub Importfromaccess()
Dim strSQL As String, strPath as String
Dim cn as Object, rs1 as Object
strPath = "C:\Users\myUser\Desktop\Database1.accdb"
Set cn = CreateObject("ADODB.connection")
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & Path & ";"
Set rs1 = CreateObject("ADODB.Recordset")
strSQL = "SELECT * FROM Tooling WHERE TID='BD0001'"
rs1.Open strSQL, cn
Sheets("Calc").Range("K1").CopyFromRecordset rs1
End Sub

Answer 3

After some thorough rearranging I think I figured it out. I'm surprised at what changes fixed the problem but the following code works:
Dim con As New ADODB.Connection
Dim rs As ADODB.Recordset
Dim cmd As New ADODB.Command
cmd.CommandText = "SELECT * FROM Tooling WHERE TID='BD0001'"
con.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=C:\Users\myUser\Desktop\Database1.accdb;"
cmd.ActiveConnection = con
Set rs = cmd.Execute
Sheets("Calc").Range("K1").CopyFromRecordset rs
rs.Close
con.Close
The final error was fixed with:
cmd.CommandText = "SELECT * FROM Tooling WHERE TID='BD0001'"
this line previously did not include single quotes around BD0001.
I also added an ActiveConnection to the Command object.
Edit: This is the simplest working version of this I could manage courtesy of all you helpful people!