使用 ADODB 将记录集打印到 Excel sheet

Using ADODB to print recordset to an Excel sheet

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

下面是我的代码大纲,但我总是出错

Run-time error '-2147467259 (80004005)' Unspecified error

(我已将我的特定参考文献替换为全部大写的虚拟参考文献)

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 方法时遇到问题。

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

  • OpenRecordset is a DAO method. Use Recordset.Open 用于 ADO
  • 删除第二个 .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