将查询从Access复制到Excel

时间:2018-03-28 03:24:53

标签: excel excel-vba ms-access excel-formula access-vba vba

当我尝试将Access从Access导入Excel时,我遇到了一些问题。

前几天我编写了一个代码(在谷歌的帮助下哈哈)将Access从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_Paso 1 _SM_Cuplas的查询。我能做什么?当我说C_Paso 2 _SM_Cuplas时,为什么要导入C_Paso 1 _SM_Cuplas?是否有其他可能将Access Query导入Excel?

1 个答案:

答案 0 :(得分:0)

试试这个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