通过VBA将访问查询复制到Excel（错误3343）

我试图复制访问查询的结果并将其粘贴到Excel选项卡中。 我search了一下，但似乎无法得到它的工作，我得到了错误“错误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 

Answer 1

考虑在初始化Database和Recordset对象之前调用Access对象。 此外，使用OpenCurrentDatabase方法，因为OpenDatabase用于DBEngine工作区对象。

 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 

Answer 2

我认为引用问题会给用户定义的types无法识别的错误。 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数据对象库作为参考这个工作