excel vba 调用ADODB 问题?

Posted 2023-04-16

excel vba 调用ADODB 问题?
Private Sub UserForm_Initialize()

On Error GoTo 100
Dim CNN As New ADODB.Connection
Dim RS1 As Recordset
Dim DB1 As Database
Set DB1 = OpenDatabase(ThisWorkbook.Path & "\" & "报价数据库.mdb")
Set RS1 = DB1.OpenRecordset(Name:="水泵", Type:=dbOpenDynaset)

For I = 1 To 1000
ComboBox1.AddItem RS1.Fields("品牌")
RS1.MoveNext
Next I

RS1.Close
Set RS1 = Nothing
Set DB1 = Nothing
Exit Sub
100:
MsgBox "找不到符合条件的记录", 1 + 16, "系统提示"

End Sub

帮我看看那里出问题了，，
ComboBox1里 调不出数据。

参考技术A Dim CNN As New ADODB.Connection
Dim RS1 As ADODB.Recordset
dim strCn as string
dim sql as string

Set RS1 = New ADODB.Recordset
Set CNN = New ADODB.Connection
CNN.CursorLocation = adUseClient
strCn = "Provider=Microsoft.Jet.OLEDB.4.0;Password=123;data source = O:\schedule\BS Schedule\Marco Temp Data\537.mdb;Persist Security Info=True" ----这里你适当改下
CNN.open (strCn )

sql = "select * from tablename "--表明改下
RS1.Open sql, CNN, adOpenKeyset, adLockOptimistic, adCmdText

rs.MoveFirst

For I = 1 To 1000
ComboBox1.AddItem RS1.Fields("品牌")
RS1.MoveNext
Next I

RS1.Close
Set RS1 = Nothing
Set DB1 = Nothing
Exit Sub
100:
MsgBox "找不到符合条件的记录", 1 + 16, "系统提示"

如果不行把 Set RS1 = Nothing
Set DB1 = Nothing 注释掉试试本回答被提问者采纳

将数据插入表时出现 ADODB VBA 自动化错误

【中文标题】将数据插入表时出现 ADODB VBA 自动化错误

【英文标题】：ADOB VBA Automation error when inserting data into table

【发布时间】：2018-07-25 17:07:16

【问题描述】：

我正在尝试在名为 DataRange2$ 的 Excel 表中插入一行。来自同一个工作簿。我收到一个（运行时自动化错误 -214721793）。当我查询 Excel 工作簿（例如 select * from DataRange2$）时，我的代码有效。我想插入一行，但出现此错误。我正在使用 ADOB、VBA 和 excel 2010。

正在发送的 SQL 查询是：

SQL = "INSERT INTO [DataSheet2$] (Name, a, b, c, d, e) VALUES ('This is a name', 10, 20, 30, 40, 50)"
`Result` is the array which is populated with the returned rows 
runQuery SQL, result

代码：

Public Function runQuery(SQL As String, ByRef result() As String) As Integer
  Dim dataConection As New ADODB.connection
  Dim mrs As New ADODB.Recordset
  Dim DBPath As String
  Dim connectionString As String
  Dim size As Integer

  Set mrs = CreateObject("ADODB.Recordset")

  'Set cursor to start
  mrs.CursorLocation = adUseClient

  'Set database path
  DBPath = ThisWorkbook.FullName

  'You can provide the full path of your external file as shown below
  connectionString = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DBPath & ";HDR=Yes';"

  'Open connection to database
  dataConection.Open connectionString

  'Open record set (query or table, connection)
  mrs.Open SQL, dataConection

  'Record set returned update data
  If mrs.EOF Then
      runQuery = 0
      Exit Function
  Else
      runQuery = mrs.RecordCount
  End If

  'Populate array with result
  ReDim result(size) As String
  Dim i As Integer

  For i = 0 To (size - 1)
      result(i) = mrs!Name
      mrs.MoveNext
  Next i

  'Close record set and connection
  mrs.Close
  dataConection.Close
End Function

工作表标题如下

Name | a | b | c | d | e | Status | Action

【问题讨论】：

Set mrs = CreateObject("ADODB.Recordset") 为什么要这样做？为什么不只是 Set mrs = New ADODB.RecordSet 来实例化它？当你单步执行你的代码时，它在哪里失败了？我不认为问题出在您的 VBA 中。您可能会发现它与表单和表单控件有关。至少，我遇到过这样的错误。

mrs.Open SQL，dataConection出现错误

这适用于像 select 这样的查询，但不适用于我认为很奇怪的 insert。另外，我刚刚声明了 createObject，因为我在网上看到的示例使用了它。

老实说，我从来没有使用过 VBA 通过 ADODB 读取或写入 excel 文件。不知道我在哪里可以看到一个很好的用途。话虽如此，请检查权限。

我正在为我的客户制作一个工具来将数据输入到外部工作簿中。我想对工作簿使用 sql，所以我不必手动编写所有 sql 代码

【参考方案1】：

尝试了两个函数 (1) 插入新行，以及 (2) 获取 x 行名称。这些需要两个单独的 ADODB.Recordset。以下是插入，但在通过 Get 时单步执行失败

Sub zz()
    Dim sSQL As String, sResult(3) As String
    sSQL = "INSERT INTO [DataSheet2$] (Name, a, b, c, d, e) 
            VALUES ('This is a name', 10, 20, 30, 40, 50)"
    'Result is the array which is populated with the returned rows
    runQuery sSQL, sResult
End Sub



Public Function runQuery(SQL As String, ByRef result() As String) As Integer
  Dim dataConection As New ADODB.Connection
  Dim mrs As New ADODB.Recordset
  Dim DBPath As String
  Dim connectionString As String
  Dim size As Integer

  Set mrs = CreateObject("ADODB.Recordset")

  'Set cursor to start
  mrs.CursorLocation = adUseClient

  'Set database path
  DBPath = ThisWorkbook.FullName

  'You can provide the full path of your external file as shown below
  connectionString = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DBPath & ";HDR=Yes';"

  'Open connection to database
  dataConection.Open connectionString

  'Open record set (query or table, connection)
  mrs.Open SQL, dataConection   '>> this is where the INSERT happens

  'Record set returned update data
  If mrs.EOF Then   ''>> rte 3704  Operation not allowed when object is closed
      runQuery = 0
      Exit Function
  Else
      runQuery = mrs.RecordCount
  End If

  'Populate array with result
  ReDim result(size) As String
  Dim i As Integer

  For i = 0 To (size - 1)
      result(i) = mrs!Name
      mrs.MoveNext
  Next i

  'Close record set and connection
  mrs.Close
  dataConection.Close
End Function

【讨论】：

我还不在家，但如果这解决了我的问题，你就是天使！