Copy Query from Access to Excel - excel

Question

I'm having some problems when I try to import a Query from Access to Excel.
Some days ago I programmed a code (with some help of Google haha) to import a Table from Access to Excel:
Sub importQuery(DBFullName As String, data_sht As Worksheet)
Dim cn As Object, rs As Object
Dim i As Integer
Dim TargetRange As Range
Dim rows As Long, cols As Long
Dim dataEmpty As Boolean
Dim lastColString As String
data_sht.Activate
Application.ScreenUpdating = False
Set TargetRange = data_sht.Range("A1")
Set cn = CreateObject("ADODB.Connection")
cn.Open "Provider=Microsoft.Ace.OLEDB.12.0; Data Source=" & DBFullName & ";" 'the Access file is .accdb
Set rs = CreateObject("ADODB.Recordset")
rs.Open "SELECT * FROM C_Paso2_SM_Cuplas", cn, , , adCmdUnspecified
cols = rs.Fields.Count
rows = data_sht.Range("A" & data_sht.rows.Count).End(xlUp).Row
' Copy titles of the Access Query
For i = 0 To (cols - 1)
TargetRange.Offset(0, i).Value = rs.Fields(i).Name
Next
' Copy data
TargetRange.Offset(1, 0).CopyFromRecordset rs
End Sub
That code works but when I do this:
rs.Open "SELECT * FROM C_Paso2_SM_Cuplas", cn, , , adCmdUnspecified
I'm importing another Query called C_Paso1_SM_Cuplas, from the same file. What can I do? Why am I importing C_Paso1_SM_Cuplas when I say C_Paso2_SM_Cuplas? Is there other possibility to import an Access Query to Excel?

Answer 1

Try this DAO solution.
Sub ImportFromAccessToExcel()
Dim db1 As Database
Dim db2 As Database
Dim recSet As Recordset
Dim strConnect As String
Set db1 = OpenDatabase("C:\Database1.mdb")
strConnect = db1.QueryDefs("Query3").Connect _
& "DSN=myDsn;USERNAME=myID;PWD=myPassword"
Set db2 = OpenDatabase("", False, False, strConnect)
db2.Close
Set db2 = Nothing
Set recSet = db1.OpenRecordset("Query3")
With ActiveSheet.QueryTables.Add(Connection:=recSet, Destination:=Range("$A$4"))
.Name = "Connection"
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
recSet.Close
db1.Close
Set recSet = Nothing
Set db1 = Nothing
End Sub