通过 VBA 将 Access 查询复制到 Excel（错误 3343）答案

【问题标题】：Copy Access Query to Excel via VBA (error 3343)通过 VBA 将 Access 查询复制到 Excel（错误 3343）
【发布时间】：2016-11-06 07:38:54
【问题描述】：

我正在尝试复制访问查询的结果并将其粘贴到 Excel 选项卡中。我搜索了一下，但似乎无法让它工作，我收到错误“错误 3343：无法识别的数据库格式”，所以我认为它与我检查过的参考资料有关。

有人知道我需要正确的参考资料吗？

参考资料：

Visual Basic 应用程序

Microsoft Excel 14.0 对象库

OLE 自动化

Microsoft Office 14.0 对象库

Microsoft ActiveX 数据对象 2.8 库

Microsft DAO 3.6 对象库

Sub Query()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim sql As String
Dim iCol As Integer

Sheets("DataDump1").Select
With Selection.ClearContents

End With
Set db = OpenDatabase("C:\Folder\DatabaseName.accdb")
Set rst = db.OpenRecordset("Query 1")

For iCol = 1 To rst.Fields.Count
 ActiveSheet.Cells(1, iCol) = rst.Fields(iCol - 1).Name
 Next iCol

ActiveSheet.Range("A2").CopyFromRecordset rst
rst.Close
db.Close
Set rst = Nothing
Set db = Nothing

End Sub

【问题讨论】：

标签： vba excel ms-access

【解决方案1】：

考虑在初始化数据库和记录集对象之前调用访问对象。此外，请使用 OpenCurrentDatabase 方法，因为 OpenDatabase 用于 DBEngine Workspace 对象。

Sub Query()
    Dim accObj As Object
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Dim sql As String
    Dim iCol As Integer

    Sheets("DataDump1").Cells.ClearContents

    Set accObj = CreateObject("Access.Application")
    accObj.OpenCurrentDatabase("C:\Folder\DatabaseName.accdb")

    Set db = accObj.CurrentDb
    Set rst = db.OpenRecordset("Query 1")

    For iCol = 1 To rst.Fields.Count
        Sheets("DataDump1").Cells(1, iCol) = rst.Fields(iCol - 1).Name
    Next iCol

    Sheets("DataDump1").Range("A2").CopyFromRecordset rst
    rst.Close
    db.Close

    Set rst = Nothing
    Set db = Nothing
    Set accObj = Nothing

End Sub

或者，无需与 Access 对象交互，因为 Access 是一个数据库，而不仅仅是一个 .exe，因此可以像任何其他 RDMS（Oracle、SQL Server、MySQL 等）一样通过 ODBC/OLEDB 进行连接

Sub RunSQL()
    Dim conn As Object, rst As Object
    Dim strConnection As String, strSQL As String
    Dim iCol As Integer

    Set conn = CreateObject("ADODB.Connection")
    Set rst = CreateObject("ADODB.Recordset")

    Sheets("DataDump1").Cells.ClearContents

'    strConnection = "DRIVER={Microsoft Access Driver (*.mdb, *.accdb)};" _
'                      & "DBQ=C:\Folder\DatabaseName.accdb;"
    strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                       & "Data Source='C:\Folder\DatabaseName.accdb';"

    strSQL = " SELECT * FROM [Query 1];"

    ' OPEN DB AND RECORDSET
    conn.Open strConnection
    rst.Open strSQL, conn

    ' COLUMN HEADERS
    For iCol = 1 To rst.Fields.Count
        Sheets("DataDump1").Cells(1, iCol) = rst.Fields(iCol - 1).Name
    Next iCol

    ' DATA ROWS
    Sheets("DataDump1").Range("A2").CopyFromRecordset rst

    rst.Close
    conn.Close    
End Sub

【讨论】：

谢谢，您的第二个解决方案对我来说非常有效。
太棒了！请注意，第二个选项不需要在用户机器上安装 MSAccess.exe。只需安装 .accdb 文件和一台 PC（应该安装 Ace/Jet 引擎 -Windows .dll 文件）。

【解决方案2】：

我认为引用问题会导致用户定义类型无法识别错误。 ADODB 而不是 DAO 应该可以工作：

Sub Query()
Dim db As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim iCol As Integer

db.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Folder\DatabaseName.accdb;"
rst.Open "Query 1", db

For iCol = 1 To rst.Fields.Count
 ActiveSheet.Cells(1, iCol) = rst.Fields(iCol - 1).Name
 Next iCol

ActiveSheet.Range("A2").CopyFromRecordset rst
rst.Close
db.Close
Set rst = Nothing
Set db = Nothing

End Sub

编辑：请添加最新的 microsoft activex 数据对象库作为参考以供参考

【讨论】：