如何使用vba将数据从访问数据库（.accdb）检索到excel

I'm working on Excel VBA macros and I want to retrieve data from a MS Access database (.accdb file).

我正在使用Excel VBA宏，我想从MS Access数据库（.accdb文件）中检索数据。

I've tried using below connection string and it throws runtime error '438'

我尝试使用下面的连接字符串，它会抛出运行时错误'438'

   Dim cn As Object, rs As Object,DBFullName As String,Target As Range
   DBFullName = "D:\Tool_Database\Tool_Database.accdb"
   Set Target = Sheets("Sheet1").Range("A1")
   Set cn = CreateObject("ADODB.Connection")
   cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & DBFullName & ";"

   Set rs = CreateObject("ADODB.Recordset")
   rs.Open "SELECT * FROM test", cn, , , adCmdText

  For int i = 0 To rs.Fields.Count - 1
  Target.Offset(1, i).Value = rs.Fields(i).Name
  Next
  Target.Offset(1, 0).CopyFromRecordset rs
  rs.Close
  Set rs = Nothing
  cn.Close
  Set cn = Nothing

PLease help me to resolve the error

请帮我解决错误

2 个解决方案

#1

I've tried using below connection string and it throws runtime error '438'

我尝试使用下面的连接字符串，它会抛出运行时错误'438'

Run-time error: '438' means that the Object doesn't support this property or method..

运行时错误：'438'表示Object不支持此属性或方法。

You are getting that error because you are mixing VB.Net with VBA

您正在收到该错误，因为您正在将VB.Net与VBA混合使用

This

这个

For int i = 0 To rs.Fields.Count - 1

should be

应该

For i = 0 To rs.Fields.Count - 1

Beside the above, I guess DBFullName = "D:\Tool_Database\Tool_Database.mdb" is a typo from your end as you are using .Accdb?

除此之外，我猜DBFullName =“D：\ Tool_Database \ Tool_Database.mdb”是您使用时的结尾错误.Accdb？

#2

This should do it for you. Drop the WHERE clause if you don't want to apply a filter.

这应该为你做。如果您不想应用过滤器，请删除WHERE子句。

Also, set a reference to: Microsoft ActiveX Data Objects 2.8 Library

另外，设置对以下内容的引用：Microsoft ActiveX Data Objects 2.8 Library

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

    DBFullName = "C:\Users\Ryan\Desktop\Nwind_Sample.mdb"

    'On Error GoTo Whoa

    Application.ScreenUpdating = False

    Set TargetRange = Sheets("Select").Range("A1")

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

    Set rs = CreateObject("ADODB.Recordset")
    rs.Open "SELECT * FROM [OrderDetails] WHERE [OrderID] = 10248", cn, , , adCmdText

    ' 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

    Application.ScreenUpdating = True
    On Error Resume Next
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
    On Error GoTo 0
    Exit Sub

End Sub

#1