Excel VBA中ADODB打开Recordset报错：Method 'Open' of Object '_Recordset' Failed

问题场景 #

在Excel VBA中使用ADODB读取Access数据库数据到UserForm的ListBox时，触发错误：Method 'Open' of Object '_Recordset' Failed，怀疑是SQL内连接查询导致。

原代码如下：

dbPath = ThisWorkbook.path & "\POS-V1.accdb" ' Database Path

Set con = New ADODB.Connection
con.ConnectionString = "Provider=Microsoft.ace.OLEDB.12.0;Data Source=" & dbPath
con.Open

Set cmd = New ADODB.Command
With cmd
    .ActiveConnection = con
    .CommandType = adCmdText
    .CommandText = "SELECT Products.ProductID, Products.BARCODE, Products.ProductName, Products.Description, Categories.CategoryName, Products.Size, Products.Stock, Products.Cost, Products.Price " & _
                   "FROM Products INNER JOIN Categories ON TRIM(Products.CategoryID) = TRIM(Categories.CategoryID)"
End With

Set rst = New ADODB.Recordset
rst.Open cmd

If Not rst.EOF Then
    frmMain.lstbox_itemlist.Clear
    frmMain.lstbox_itemlist.AddItem "ProductID"
    frmMain.lstbox_itemlist.List(0, 1) = "BARCODE"
    frmMain.lstbox_itemlist.List(0, 2) = "ProductName"
    frmMain.lstbox_itemlist.List(0, 3) = "Description"
    frmMain.lstbox_itemlist.List(0, 4) = "CategoryName"
    frmMain.lstbox_itemlist.List(0, 5) = "Size"
    frmMain.lstbox_itemlist.List(0, 6) = "Stock"
    frmMain.lstbox_itemlist.List(0, 7) = "Cost"
    frmMain.lstbox_itemlist.List(0, 8) = "Price"

    Dim rowIndex As Long
    rowIndex = 1

    Do Until rst.EOF
        frmMain.lstbox_itemlist.AddItem rst.Fields("ProductID").Value
        frmMain.lstbox_itemlist.List(rowIndex, 1) = rst.Fields("BARCODE").Value
        frmMain.lstbox_itemlist.List(rowIndex, 2) = rst.Fields("ProductName").Value
        frmMain.lstbox_itemlist.List(rowIndex, 3) = rst.Fields("Description").Value
        frmMain.lstbox_itemlist.List(rowIndex, 4) = rst.Fields("CategoryName").Value
        frmMain.lstbox_itemlist.List(rowIndex, 5) = rst.Fields("Size").Value
        frmMain.lstbox_itemlist.List(rowIndex, 6) = rst.Fields("Stock").Value
        frmMain.lstbox_itemlist.List(rowIndex, 7) = rst.Fields("Cost").Value
        frmMain.lstbox_itemlist.List(rowIndex, 8) = rst.Fields("Price").Value

        rowIndex = rowIndex + 1
        rst.MoveNext
    Loop
End If

rst.Close
con.Close

Set rst = Nothing
Set cmd = Nothing
Set con = Nothing
End Sub

错误根源分析 #

1. TRIM函数的误用：
   • 如果CategoryID是数字类型（比如长整型），对数字字段使用TRIM()函数会直接导致SQL语法错误，因为TRIM仅适用于文本字符串。
   • 即使是文本类型，TRIM可能会让数据库无法使用索引，导致查询执行失败或效率低下，同时如果字段存在NULL值，TRIM处理后也会引发比较错误。
2. Recordset打开参数缺失：默认打开方式可能不兼容当前查询结果，需要显式指定光标类型和锁定类型。
3. 缺乏错误捕获：无法精准定位SQL执行时的具体错误（比如字段不存在、类型不匹配）。

解决方案 #

步骤1：验证SQL语句 #

打开Access数据库，直接在查询设计器中运行你的SQL语句，查看是否能正常返回结果。这是最快定位SQL语法/逻辑错误的方法。

步骤2：修正SQL连接条件 #

• 如果CategoryID是数字类型，直接删除TRIM：

  SELECT Products.ProductID, Products.BARCODE, Products.ProductName, Products.Description, Categories.CategoryName, Products.Size, Products.Stock, Products.Cost, Products.Price 
  FROM Products INNER JOIN Categories ON Products.CategoryID = Categories.CategoryID
  

• 如果是文本类型，确认字段是否真的有多余空格。若必须保留TRIM，可改用LIKE（但性能较差），或者先清理数据库中的空格：

  SELECT Products.ProductID, Products.BARCODE, Products.ProductName, Products.Description, Categories.CategoryName, Products.Size, Products.Stock, Products.Cost, Products.Price 
  FROM Products INNER JOIN Categories ON Products.CategoryID LIKE TRIM(Categories.CategoryID) & '*'
  

步骤3：优化Recordset打开方式 #

显式指定光标类型和锁定类型，避免默认设置导致的兼容性问题：

rst.Open cmd, , adOpenStatic, adLockReadOnly

（需要确保已引用ADODB库，或使用常量数值：adOpenStatic=3，adLockReadOnly=1）

步骤4：添加错误捕获 #

在代码中加入错误处理，方便定位具体错误：

On Error GoTo ErrorHandler
' 你的原有代码
Exit Sub
ErrorHandler:
    MsgBox "错误编号：" & Err.Number & vbCrLf & "错误描述：" & Err.Description
    ' 确保关闭连接和记录集
    If Not rst Is Nothing Then
        If rst.State = adStateOpen Then rst.Close
        Set rst = Nothing
    End If
    If Not con Is Nothing Then
        If con.State = adStateOpen Then con.Close
        Set con = Nothing
    End If
    Set cmd = Nothing

修正后的完整代码 #

Private Sub LoadDataToListBox()
    Dim dbPath As String
    Dim con As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rst As ADODB.Recordset
    Dim rowIndex As Long

    On Error GoTo ErrorHandler

    dbPath = ThisWorkbook.Path & "\POS-V1.accdb" ' 数据库路径

    ' 初始化连接
    Set con = New ADODB.Connection
    con.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
    con.Open

    ' 初始化命令对象
    Set cmd = New ADODB.Command
    With cmd
        .ActiveConnection = con
        .CommandType = adCmdText
        ' 假设CategoryID是数字类型，去掉TRIM
        .CommandText = "SELECT Products.ProductID, Products.BARCODE, Products.ProductName, Products.Description, Categories.CategoryName, Products.Size, Products.Stock, Products.Cost, Products.Price " & _
                       "FROM Products INNER JOIN Categories ON Products.CategoryID = Categories.CategoryID"
    End With

    ' 打开记录集，指定光标和锁定类型
    Set rst = New ADODB.Recordset
    rst.Open cmd, , adOpenStatic, adLockReadOnly

    ' 填充ListBox
    If Not rst.EOF Then
        frmMain.lstbox_itemlist.Clear
        ' 添加表头
        With frmMain.lstbox_itemlist
            .ColumnCount = 9
            .List(0, 0) = "ProductID"
            .List(0, 1) = "BARCODE"
            .List(0, 2) = "ProductName"
            .List(0, 3) = "Description"
            .List(0, 4) = "CategoryName"
            .List(0, 5) = "Size"
            .List(0, 6) = "Stock"
            .List(0, 7) = "Cost"
            .List(0, 8) = "Price"
        End With

        rowIndex = 1
        Do Until rst.EOF
            With frmMain.lstbox_itemlist
                .AddItem rst.Fields("ProductID").Value
                .List(rowIndex, 1) = rst.Fields("BARCODE").Value
                .List(rowIndex, 2) = rst.Fields("ProductName").Value
                .List(rowIndex, 3) = rst.Fields("Description").Value
                .List(rowIndex, 4) = rst.Fields("CategoryName").Value
                .List(rowIndex, 5) = rst.Fields("Size").Value
                .List(rowIndex, 6) = rst.Fields("Stock").Value
                .List(rowIndex, 7) = rst.Fields("Cost").Value
                .List(rowIndex, 8) = rst.Fields("Price").Value
            End With
            rowIndex = rowIndex + 1
            rst.MoveNext
        Loop
    End If

Cleanup:
    ' 释放资源
    If Not rst Is Nothing Then
        If rst.State = adStateOpen Then rst.Close
        Set rst = Nothing
    End If
    If Not con Is Nothing Then
        If con.State = adStateOpen Then con.Close
        Set con = Nothing
    End If
    Set cmd = Nothing
    Exit Sub

ErrorHandler:
    MsgBox "错误编号：" & Err.Number & vbCrLf & "错误描述：" & Err.Description
    GoTo Cleanup
End Sub

内容的提问来源于stack exchange，提问作者Adonis Jr. San Juan Sanchez