CODEWITHSUNDEEP
sqlvbasql-server-2008excel
user3666237
user3666237

Reputation: 153

"Object Required" error

I have an SQL query that I'm running out of Excel. The objective is to run the query and paste the data into a designated location: 

    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

When run I get:

The following error has occurred- Object required" Error code 424.

Why am I experiencing this issue?

Upvotes: 0

Views: 3001

Answers (1)

Tim Williams
Tim Williams

Reputation: 166550

Does this work?

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

Upvotes: 1

Related Questions