如何使用 excel VBA 运行访问查询？

Posted 2023-04-13

【中文标题】如何使用 excel VBA 运行访问查询？

【英文标题】：How to run access query using excel VBA?

【发布时间】：2018-08-14 20:51:45

【问题描述】：

我是 Access 的新手，我一直在尝试运行 Access 查询并使用 VBA 将结果粘贴到 Excel 中。我结合了一些我找到的代码，我想我几乎拥有它，但无法弄清楚最后一步。代码如下：

Sub test()


Dim ws As Worksheet
Dim A As Object
Dim rs As Object

Application.DisplayAlerts = False

Set A = CreateObject("Access.Application")
Set ws = ThisWorkbook.Sheets("Sheet1")

A.Visible = True
A.OpenCurrentDatabase ("access database path")
A.DoCmd.OpenQuery ("query name")

Set rs = A.CurrentDb().QueryDefs("query name").OpenRecordset()

If Not rs.EOF Then
    ws.Range("A1").CopyFromRecordset rs
End If

rs.Close

 Application.DisplayAlerts = True

End Sub

我正在尝试运行查询并将结果粘贴到工作表 1 的单元格 A1 中。

我收到以下行的“运行时错误 3219”：

Set rs = A.CurrentDb().QueryDefs("query name").OpenRecordset()

任何帮助将不胜感激。

谢谢，

G

【问题讨论】：

看看使用ADO和www.connectionstrings.com

该代码在 Excel 2010 中使用我的“访问数据库路径”和“查询名称”为我工作。请向我们展示您的“查询名称”中的 SQL。

【参考方案1】：

我修改了您的代码以从 Access 查询中获取数据，而无需创建完整的 Access.Application 实例。在 Excel 2010 中测试和工作。

Const cstrPath As String = "C:\share\Access\Database2.accdb"
Const cstrQuery As String = "qryBase"
Dim dbe As Object 'DAO.DBEngine '
Dim rs As Object 'DAO.Recordset '
Dim ws As Worksheet

Application.DisplayAlerts = True 'leave alerts on during testing '
Set dbe = CreateObject("DAO.DBEngine.120")
Set rs = dbe.OpenDatabase(cstrPath).OpenRecordset(cstrQuery)

If Not rs.EOF Then
    Set ws = ThisWorkbook.Sheets("Sheet1")
    ws.Range("A1").CopyFromRecordset rs
End If

rs.Close
Application.DisplayAlerts = True

【讨论】：

我遇到了“Set rs = dbe.OpenDatabase(cstrPath).OpenRecordset(cstrQuery)”的问题。与问题中所述相同的运行时错误。我的查询名称是“Perf Sales”，当我手动运行查询时工作正常。

您好，抱歉回复晚了。我有点忙。我尝试了另一个访问文件，它运行良好。不完全确定数据库出了什么问题，但您的代码有效:)

嘿，我刚刚意识到这不会拉表的标题。为什么要这样做？

CopyFromRecordset 从不导入标题。您必须单独循环遍历记录集的 Fields 集合，并将每个集合的名称写入工作表。例子比比皆是：copyfromrecordset with headers

【参考方案2】：

我会使用 ADODB 记录集。试试下面的代码。这里我连接的是一个excel工作簿，但是你可以使用相同的逻辑来访问数据库，你只需要更改连接字符串。

Private con As ADODB.Connection
Private ra As ADODB.Recordset



' SqlString = SQL Query
' Sht = Sheet Name, where the output needs to be displayed
' Rng = Range ("C5"), where the output needs to be displayed

Sub DoSql(SqlString As String, Sht As String, Rng As String, Optional IncludeHeading As Boolean = False)

Dim a As String

Dim res As Variant

Set con = New ADODB.Connection
Set ra = New ADODB.Recordset

res = ""

'a = Set the appropriate connection string for your database
'The below connection is referring to the same excel workbook which contains the macro


a = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=""" & ThisWorkbook.FullName & """;Extended Properties=""Excel 12.0 Xml;HDR=YES"";"

'MsgBox a
'MsgBox SqlString

If Not Left("" & con, 8) = "Provider" Then
    con.Open a
End If

If Not ra.State = 0 Then
    ra.Close
End If

ra.Open SqlString, con

If Not (ra.EOF And ra.BOF) Then
    ra.MoveFirst

    Sheets(Sht).Select

    If IncludeHeading = True Then
        For intColIndex = 0 To ra.Fields.Count - 1
            Range(Rng).Offset(0, intColIndex).Value = ra.Fields(intColIndex).Name
        Next
        Range(Rng).Offset(1, 0).CopyFromRecordset ra
    Else
        Range(Rng).CopyFromRecordset ra
    End If

End If
ra.Close
con.Close



End Sub