使用 ADODB 将记录集打印到 Excel 工作表

Question

我正在尝试使用 ADODB 连接从查询创建记录集，然后将该记录集的内容复制到一系列单元格中

下面是我的代码大纲，但我不断收到错误

运行时错误'-2147467259 (80004005)'未指定错误

（我已将我的特定引用替换为所有大写的虚拟引用）

Sub Subroutine()

'establish ADODB connection to retrieve data from TABLE

Dim objConnection As New ADODB.connection
Dim objRecordset As New ADODB.Recordset

With objConnection
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Data Source = MYDATASOURCE" & _
    "Extended Properties = Excel 8.0;HDR = Yes;"
    .Open
End With

'use query to record data to Excel range
Set objRecordset = objConnection.OpenRecordset("Select * From TABLE Where FieldNm = NAME")

With objRecordset
.Open
.MoveFirst

Do Until .EOF
    Worksheets("WORKSHEET").Cells(14, 1) = objRecordset.Fields.Item("FieldNm")
    .MoveNext
Loop

End With

End Sub

调试转到我的With objConnection 块中的.Open。在此之前，我遇到了.MoveNext 方法的问题。

Answer 1

假设您的 SQL 正确指定了工作表范围，请考虑调整 With...End With 块内外的一些项目。

• OpenRecordset 是一种 DAO 方法。为 ADO 使用 Recordset.Open
• 删除第二个.Open 调用
• 删除With中的记录集名称
• 向下循环遍历工作表，而不是重新分配相同的单元格
• 使用错误处理获取更多信息的错误消息以捕获运行时异常

VBA

Sub Subroutine()
On Error Goto ErrHandle

    '...same as above...

    objRecordset.Open "Select * From TABLE Where FieldNm = NAME", objConnection

    With objRecordset
        .MoveLast
        .MoveFirst

        i = 0
        Do Until .EOF
            Worksheets("WORKSHEET").Cells(14 + i, 1) = .Fields("FieldNm")

            i = i + 1
            .MoveNext
        Loop    

        .Close
    End With

    objConnection.Close

ExitHandle:
    Set objRecordset = Nothing
    Set objConnection = Nothing
    Exit Sub

ErrHandle:
    Msgbox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR"
    Resume ExitHandle
End Sub