2016-07-04 104 views
2

我试图复制访问查询的结果并将其粘贴到Excel选项卡中。我搜索了一下,但似乎无法得到它的工作,我得到错误“错误3343:无法识别的数据库格式”,所以我认为它与我检查过的引用有关。通过VBA将访问查询复制到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 

回答

1

考虑初始化数据库和Recordset对象之前调用访问对象。此外,使用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 

可替代地,不需要与访问对象的访问的接口是一个数据库而不仅仅是一个.exe所以可以通过ODBC/OLEDB连接像任何其他RDMS(甲骨文,SQL服务器,MySQL的等)

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 
+0

谢谢你,你的第二个解决方案对我来说非常合适。 – JBlack

+0

太棒了!并且请注意,第二个选项不需要在用户机器上安装MSAccess.exe。只需安装.accdb文件和一台PC(应安装Ace/Jet引擎-Windows .dll文件)。 – Parfait

0

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