繁体   English   中英

如何使用vba从access数据库(.accdb)中检索数据到excel中

[英]How to retrieve data from access database(.accdb) into excel using vba

我正在处理 Excel VBA 宏,我想从 MS Access 数据库( .accdb文件)中检索数据。

我试过使用下面的连接字符串,它抛出运行时错误“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

请帮我解决错误

我试过使用下面的连接字符串,它抛出运行时错误“438”

Run-time error: '438'表示Object doesn't support this property or method..

您收到该错误是因为您将VB.NetVBA混合使用

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

应该是

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

除了上述内容,我猜DBFullName = "D:\\Tool_Database\\Tool_Database.mdb"是您使用.Accdb的拼写错误?

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

另外,设置对: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

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM