从Access复制查询到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_Paso 1 _SM_Cuplas, from the same file. What can I do? Why am I importing C_Paso 1 _SM_Cuplas when I say C_Paso 2 _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