将查询从 Access 复制到 Excel

Question

我在尝试将查询从 Access 导入 Excel 时遇到了一些问题。

几天前，我编写了一个代码（在 Google 的帮助下哈哈）将表格从 Access 导入 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

该代码有效，但当我这样做时：

rs.Open "SELECT * FROM C_Paso2_SM_Cuplas", cn, , , adCmdUnspecified

我正在从同一个文件中导入另一个名为 C_Paso1_SM_Cuplas 的查询。我能做些什么？为什么我说 C_Paso2_SM_Cuplas 时要导入 C_Paso1_SM_Cuplas？是否有其他可能将 Access Query 导入 Excel？

Answer 1

试试这个 DAO 解决方案。

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