编写 Excel VBA 以从 Access 接收数据 [英] Writing Excel VBA to receive data from Access

问题描述

我正在编写一个从 Access 数据库中提取数据的 Excel 应用程序.当用户打开 Excel 工具时，数据表需要填充我创建的 Access 数据库中的工作表之一.我一直在用 excel 编写 VBA 代码，但收到运行时错误:429"ActiveX 组件无法创建对象.

I am writing an excel application that draws from an Access database for work. When the user opens the Excel tool, a data table needs to populate one of the worksheets from the Access database that I created. I have been writing the VBA code in excel and I am receiving Run-Time Error: "429" ActiveX Component Can't Create Object.

其他问题都是从 Access 编写的，但我相信我需要从 Excel 工作簿文件编写的这段代码.我编写的代码位于 Workbook_Open() 函数中，以便在用户打开文件时立即收集数据.非常感谢您的帮助.顺便说一句，我使用的是 Access 2007 和 Excel 2010.

The other questions are all written from Access but I believe I need this code written from the Excel workbook file. The code I have written is in the Workbook_Open() function so that the data is collected right as the user opens the file. Thanks very much for the help. BTW, I am using Access 2007 and Excel 2010.

Private Sub Workbook_Open()
    'Will fill the first listbox with data from the Access database
    Dim DBFullName As String
    Dim TableName As String
    Dim FieldName As String
    Dim TargetRande As String

    DBFullName = "D:Tool_DatabaseTool_Database.mdb"

    Dim db As DAO.Database, rs As Recordset
    Dim intColIndex As Integer

    Set TargetRange = Range("A1")
    Set db = OpenDatabase(DBFullName)
    Set rs = db.OpenRecordset("SELECT * FROM ToolNames WHERE Item = 'Tool'", dbReadOnly)

    ' Write the field names
    For intColIndex = 0 To rs.Fields.Count - 1
        TargetRange.Offset(1, intColIndex).Value = rs.Fields(intColIndex).Name
    Next

    ' Write recordset
    TargetRange.Offset(1, 0).CopyFromRecordset rs

    Set rs = Nothing
    db.Close
    Set db = Nothing
End Sub

推荐答案

Tyler，你能帮我测试一下这段代码吗?如果出现任何错误，您将收到一个消息框.只需发布消息框的快照.

Tyler, Could you please test this code for me? If you get any error you will get a Message Box. Simply post a snapshot of the Message Box.

'~~> Remove all references as the below code uses Late Binding with ADO.

Private Sub Workbook_Open()
          Dim cn As Object, rs As Object
          Dim intColIndex As Integer
          Dim DBFullName As String
          Dim TargetRange As Range

10        DBFullName = "D:Tool_DatabaseTool_Database.mdb"

20        On Error GoTo Whoa

30        Application.ScreenUpdating = False

40        Set TargetRange = Sheets("Sheet1").Range("A1")

50        Set cn = CreateObject("ADODB.Connection")
60        cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DBFullName & ";"

70        Set rs = CreateObject("ADODB.Recordset")
80        rs.Open "SELECT * FROM ToolNames WHERE Item = 'Tool'", cn, , , adCmdText

          ' Write the field names
90        For intColIndex = 0 To rs.Fields.Count - 1
100           TargetRange.Offset(1, intColIndex).Value = rs.Fields(intColIndex).Name
110       Next

          ' Write recordset
120       TargetRange.Offset(1, 0).CopyFromRecordset rs

LetsContinue:
130       Application.ScreenUpdating = True
140       On Error Resume Next
150       rs.Close
160       Set rs = Nothing
170       cn.Close
180       Set cn = Nothing
190       On Error GoTo 0
200       Exit Sub
Whoa:
210       MsgBox "Error Description :" & Err.Description & vbCrLf & _
             "Error at line     :" & Erl & vbCrLf & _
             "Error Number      :" & Err.Number
220       Resume LetsContinue
End Sub

这篇关于编写 Excel VBA 以从 Access 接收数据的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！