How to return values from a SQL Server Stored Procedure and Utilise them in Access VBA

Set cnn = New adodb.Connection
cnn.ConnectionString = 
   "DRIVER=SQL Server;SERVER=SERVER\SERVER;DATABASE=a_db;Trusted_Connection=Yes"

cnn.Open cnn.ConnectionString

Set cmd = New adodb.Command
cmd.ActiveConnection = cnn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "stprMoveDataSet"

Set param1 = cmd.CreateParameter
               ("@DataSetID", adInteger, adParamInput, , stDataSet)
cmd.Parameters.Append param
Set param2 = cmd.CreateParameter
               ("@Destination", adChar, adParamInput, 1, stDestination)
cmd.Parameters.Append param
Set param3 = cmd.CreateParameter
               ("@errStatusOK", adBit, adParamOutput, , adParamReturnValue)
cmd.Parameters.Append param

rs.CursorType = adOpenStatic
rs.CursorLocation = adUseClient
rs.LockType = adLockOptimistic
rs.Open cmd

Several ways are possible to get values back using VBA.

1. Recordset
2. Count of records affected (only for Insert/Update/Delete otherwise -1)
3. Output parameter
4. Return value

My code demonstrates all four. Here is a stored procedure that returns a value:

Create PROCEDURE CheckExpedite
    @InputX  varchar(10),
    @InputY int,
    @HasExpedite int out
AS
BEGIN
    Select @HasExpedite = 9 from <Table>
    where Column2 = @InputX and Column3 = @InputY

    If @HasExpedite = 9
        Return 2
    Else
        Return 3
End

Here is the sub I use in Excel VBA. You'll need reference to Microsoft ActiveX Data Objects 2.8 Library.

Sub CheckValue()

    Dim InputX As String: InputX = "6000"
    Dim InputY As Integer: InputY = 2014

    'open connnection
    Dim ACon As New Connection
    'ACon.Open ("Provider=SQLOLEDB;Data Source=<SqlServer>;" & _
    '    "Initial Catalog=<Table>;Integrated Security=SSPI")

    'set command
    Dim ACmd As New Command
    Set ACmd.ActiveConnection = ACon
    ACmd.CommandText = "CheckExpedite"
    ACmd.CommandType = adCmdStoredProc

    'Return value must be first parameter else you'll get error from too many parameters
    'Procedure or function "Name" has too many arguments specified.
    ACmd.Parameters.Append ACmd.CreateParameter("ReturnValue", adInteger, adParamReturnValue)
    ACmd.Parameters.Append ACmd.CreateParameter("InputX", adVarChar, adParamInput, 10, InputX)
    ACmd.Parameters.Append ACmd.CreateParameter("InputY", adInteger, adParamInput, 6, InputY)
    ACmd.Parameters.Append ACmd.CreateParameter("HasExpedite", adInteger, adParamOutput)

    Dim RS As Recordset
    Dim RecordsAffected As Long

    'execute query that returns value
    Call ACmd.Execute(RecordsAffected:=RecordsAffected, Options:=adExecuteNoRecords)

    'execute query that returns recordset
    'Set RS = ACmd.Execute(RecordsAffected:=RecordsAffected)

    'get records affected, return value and output parameter
    Debug.Print "Records affected: " & RecordsAffected
    Debug.Print "Return value: " & ACmd.Parameters("ReturnValue")
    Debug.Print "Output param: " & ACmd.Parameters("HasExpedite")

    'use record set here
    '...

    'close
    If Not RS Is Nothing Then RS.Close
    ACon.Close

End Sub

I'd initially looked at OUTPUT Parameters, but could not find out how to get them back to Access (in VBA) to then provide feedback to the user. A colleague suggested using a SELECT in the Stored procedure and to use this.

STORED PROCEDURE: Added the following at the end:

SELECT @errStatusOK as errStatusOK, @countCurrent as countCurrent, @countHistorical as countHistorical

VBA:

Dim cnn As ADODB.Connection
Dim cmd As New ADODB.Command, rs As New ADODB.Recordset, param As New ADODB.Parameter
Dim fld As ADODB.Field
Dim stMessage As String

Set cnn = New ADODB.Connection
cnn.ConnectionString = "DRIVER=SQL Server;SERVER=SERVER\SERVER;DATABASE=a_db;Trusted_Connection=Yes"

cnn.Open cnn.ConnectionString

Set cmd = New ADODB.Command
cmd.ActiveConnection = cnn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "stprMoveDataSet"

Set param = cmd.CreateParameter("@DataSetID", adInteger, adParamInput, , stDataSet)
cmd.Parameters.Append param
Set param = cmd.CreateParameter("@Destination", adChar, adParamInput, 1, stDestination)
cmd.Parameters.Append param

rs.CursorType = adOpenStatic
rs.CursorLocation = adUseClient
rs.LockType = adLockOptimistic
'rs.Open cmd
Set rs = cmd.Execute
If rs!errstatusok = True Then
    stMessage = "Operation appears to have been successful, check the DataSets Listing..." & Chr(13) & "Also, the Server returned the following information: ["
Else
    stMessage = "Operation appears to have failed, check the DataSets Listing..." & Chr(13) & "Also, the Server returned the following information: ["
End If
For Each fld In rs.Fields
    stMessage = stMessage & "| " & fld.Name & " / " & fld.Value & " |"
Next fld
stMessage = stMessage & "]"

MsgBox stMessage

This returns the folliwing: Operation appears to have failed, check the DataSets Listing... Also, the Server returned the following information: [| errStatusOK / False || countCurrent / 0 || countHistorical / 10 |]