“需要对象”错误

Question

我有一个 SQL 查询用完了 Excel。目标是运行查询并将数据粘贴到指定位置：

    Public Function Pull_SQL_Data()

        ''''On Error GoTo Err:

Worksheets("Data").Select
Range("B7").Select
Do Until ActiveCell = ""
ActiveCell.Offset(1).Select
Loop
Range("B:S", ActiveCell.Offset(-1, 3)).ClearContents

Worksheets("Data").Select
Range("B7").Select

Dim cnPubs As New ADODB.Connection
Dim strConn As String
Dim rstRecordsets As New ADODB.Recordset
Dim intColIndex As Integer
Dim strSQL As Variant

Application.ScreenUpdating = False
Application.Cursor = xlWait

Set cnPubs = New ADODB.Connection
Set rsPubs = New ADODB.Recordset

Set outCell = Sheets("Data").Range("B7")

strSQL = Sheets("SQL").Range("G1")

strConn = "PROVIDER=SQLOLEDB;"
cnPubs.CommandTimeout = 240
strConn = strConn & "DATA SOURCE=CFS-Serversql;INITIAL CATALOG=UserAnalysis;"
strConn = strConn & "INTEGRATED SECURITY=sspi;"

cnPubs.Open strConn
With rsPubs
     .ActiveConnection = cnPubs
     .Open strSQL, cnPubs, adOpenStatic, adLockReadOnly, adCmdText


Sheets("Data").Range("B7:S500").ClearContents
Sheets("Data").Range("B4").CopyFromRecordset rsPubs


End With

rsPubs.Close
cnPubs.Close
Set rsPubs = Nothing
Set cnPubs = Nothing

Application.Cursor = xlDefault

Exit Function

Err:
    MsgBox "The following error has occured-" & vbCrLf & vbCrLf & VBA.Error, vbCritical, "SQL Connection"
    MsgBox VBA.Err

    Application.Cursor = xlDefault
    Worksheets("DWH").Select
    Range("A1").Select

End Function

运行时我得到：

发生以下错误 - 需要对象”错误代码 424。

为什么我会遇到这个问题？

Answer 1

这行得通吗？

Public Function Pull_SQL_Data()

    Dim ws As Worksheet
    Dim cnPubs As ADODB.Connection
    Dim rsPubs As ADODB.Recordset
    Dim strConn As String
    Dim strSQL As Variant

    Set ws = Worksheets("Data")

    Set cnPubs = New ADODB.Connection
    Set rsPubs = New ADODB.Recordset

    strSQL = Sheets("SQL").Range("G1").Value

    strConn = "PROVIDER=SQLOLEDB;DATA SOURCE=CFS-Serversql;" & _
              "INITIAL CATALOG=UserAnalysis;INTEGRATED SECURITY=sspi;"

    cnPubs.Open strConn

    rsPubs.Open strSQL, cnPubs, adOpenStatic, adLockReadOnly, adCmdText

    ws.Range("B7:S500").ClearContents

    If Not rsPubs.EOF Then
        ws.Range("B4").CopyFromRecordset rsPubs
    Else
        MsgBox "No records were returned!"
    End If

    rsPubs.Close
    cnPubs.Close

End Function