Using ADODB to print recordset to an Excel sheet

问题

I'm trying to use an ADODB connection to create a record set from a query, then copy the contents of that record set into a range of cells

Below is the outline of my code, but I keep getting errors

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

(I've replaced my specific references with all caps dummy references)

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

The debug goes to the .Open in my With objConnection block. Before that I was having problems with the .MoveNext method.

回答1:

Assuming your SQL is correctly specifying worksheet range, consider adjusting some items in and outside of With...End With block.

OpenRecordset is a DAO method. Use Recordset.Open for ADO
Remove the second .Open call
Remove the recordset name inside With
Loop through worksheet down the rows instead of reassign same cell
Use error handling for more informative error message to capture runtime exceptions

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

来源：https://stackoverflow.com/questions/47518422/using-adodb-to-print-recordset-to-an-excel-sheet

标签

vba

ado