Run SQL Server stored procedure from VBA

Question

This is my stored procedure which works fine in SQL Server Management Studio.

exec GroupCommissions @GroupNumberEntry = '01142' 

Should produce a table of data.

I'm trying to run it in vba using the following code:

 Dim rs As ADODB.Recordset
    Dim cnSQL As ADODB.Connection
    Dim sqlcommand As ADODB.Command, prm As Object

    Set cnSQL = New ADODB.Connection
    cnSQL.Open "Provider=SQLOLEDB; Data Source=bddc1didw1;Initial Catalog=Actuarial; Trusted_connection=Yes; Integrated Security='SSPI'"

    Set sqlcommand = New ADODB.Command
    sqlcommand.ActiveConnection = cnSQL

    sqlcommand.CommandType = adCmdStoredProc
    sqlcommand.CommandText = "GroupCommissions"
    Set prm = sqlcommand.CreateParameter("GroupNumberEntry", adParamInput)
    sqlcommand.Parameters.Append prm
    sqlcommand.Parameters("GroupNumberEntry").Value = "01142"

    Set rs = New ADODB.Recordset
    rs.CursorType = adOpenStatic
    rs.LockType = adLockOptimistic
    rs.Open sqlcommand

    ActiveSheet.Range("a3").CopyFromRecordset rs

But it just returns blank and I can't work out what I'm doing wrong. Also is there a simpler way to do this?

As discussed below i've managed to fix the issue by adding SET NOCOUNT ON to the original stored procedure. My issue now is I want to do a second stored procedure in the same code but it only seems to work for one. They both work individually however. So either I have to reopen the connection or use 2 on the defined variables? Here is the code:

Dim rs As ADODB.Recordset

    Dim cnSQL As ADODB.Connection
    Dim sqlcommand As ADODB.Command, prm As Object, prm2 As Object

    Set cnSQL = New ADODB.Connection
    cnSQL.Open "Provider=SQLOLEDB; Data Source=bddc1didw1;Initial Catalog=Actuarial; Trusted_connection=Yes; Integrated Security='SSPI'"

    Set sqlcommand = New ADODB.Command


    sqlcommand.ActiveConnection = cnSQL


'groupdates

    sqlcommand.CommandType = adCmdStoredProc
    sqlcommand.CommandText = "GroupDate"
    Set prm = sqlcommand.CreateParameter("GroupNumberEntry", adVarChar, adParamInput, 5)
    Set prm2 = sqlcommand.CreateParameter("ValuationDateEntry", adDate, adParamInput)
    sqlcommand.Parameters.Append prm
    sqlcommand.Parameters.Append prm2

    sqlcommand.Parameters("GroupNumberEntry").Value = "01132"
    sqlcommand.Parameters("ValuationDateEntry").Value = "08-31-2019"


    Set rs = New ADODB.Recordset
    rs.CursorType = adOpenStatic
    rs.LockType = adLockOptimistic
    rs.Open sqlcommand

    ActiveSheet.Range("a2").CopyFromRecordset rs



    'GroupCommissions


    sqlcommand.CommandType = adCmdStoredProc
    sqlcommand.CommandText = "GroupCommissions"
    Set prm = sqlcommand.CreateParameter("GroupNumberEntry", adVarChar, adParamInput, 5)

    sqlcommand.Parameters.Append prm
    sqlcommand.Parameters("GroupNumberEntry").Value = "01132"

    Set rs = New ADODB.Recordset
    rs.CursorType = adOpenStatic
    rs.LockType = adLockOptimistic
    rs.Open sqlcommand

    ActiveSheet.Range("DB2").CopyFromRecordset rs

Answer 1

Try replacing that line with something like this:

Set prm = sqlcommand.CreateParameter("GroupNumberEntry", adVarChar, GroupNumberEntry, 255)

Set the field type and length according to how your proc is defined.

Your code looked OK to me so I copied it into Excel (2016...) and tried it. It gave me an error on that line but adding the additional parameter values to CreateParameter fixed the issue. shrug It shouldn't matter since those are optional parameters, unless there is something maybe at the provider level.

Answer 2

you can try just sending the SQL PROCEDURE straight through as a CALL function. Take a look at this:

Public connDB As New ADODB.Connection
Public rs As New ADODB.Recordset
Public strSQL As String
Public strConnectionstring As String
Public strServer As String
Public strDBase As String
Public strUser As String
Public strPwd As String
Public PayrollDate As String

Sub WriteStoredProcedure()
     PayrollDate = "2017/05/25"
     Call ConnectDatabase
     On Error GoTo errSP
     strSQL = "EXEC spAgeRange '" & PayrollDate & "'"
     connDB.Execute (strSQL)
     Exit Sub
errSP:
MsgBox Err.Description
End Sub

Sub ConnectDatabase()
     If connDB.State = 1 Then connDB.Close
     On Error GoTo ErrConnect
     strServer = "SERVERNAME" ‘The name or IP Address of the SQL Server
     strDBase = "TestDB"
     strUser = "" 'leave this blank for Windows authentication
     strPwd = ""

     If strPwd > "" Then
         strConnectionstring = "DRIVER={SQL Server};Server=" & strServer & ";Database=" & strDBase & ";Uid=" & strUser & ";Pwd=" & strPwd & ";Connection Timeout=30;"
     Else
         strConnectionstring = "DRIVER={SQL Server};SERVER=" & strServer & ";Trusted_Connection=yes;DATABASE=" &    strDBase 'Windows authentication
     End If
     connDB.ConnectionTimeout = 30
     connDB.Open strConnectionstring
Exit Sub
ErrConnect:
     MsgBox Err.Description
End Sub