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

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 outASBEGIN    Select @HasExpedite = 9 from <Table>    where Column2 = @InputX and Column3 = @InputY    If @HasExpedite = 9        Return 2    Else        Return 3End

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.CloseEnd Sub

Set cnn = New adodb.Connectioncnn.ConnectionString =    "DRIVER=SQL Server;SERVER=SERVER\SERVER;DATABASE=a_db;Trusted_Connection=Yes"cnn.Open cnn.ConnectionStringSet cmd = New adodb.Commandcmd.ActiveConnection = cnncmd.CommandType = adCmdStoredProccmd.CommandText = "stprMoveDataSet"Set param1 = cmd.CreateParameter               ("@DataSetID", adInteger, adParamInput, , stDataSet)cmd.Parameters.Append paramSet param2 = cmd.CreateParameter               ("@Destination", adChar, adParamInput, 1, stDestination)cmd.Parameters.Append paramSet param3 = cmd.CreateParameter               ("@errStatusOK", adBit, adParamOutput, , adParamReturnValue)cmd.Parameters.Append paramrs.CursorType = adOpenStaticrs.CursorLocation = adUseClientrs.LockType = adLockOptimisticrs.Open cmd

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.ConnectionDim cmd As New ADODB.Command, rs As New ADODB.Recordset, param As New ADODB.ParameterDim fld As ADODB.FieldDim stMessage As StringSet cnn = New ADODB.Connectioncnn.ConnectionString = "DRIVER=SQL Server;SERVER=SERVER\SERVER;DATABASE=a_db;Trusted_Connection=Yes"cnn.Open cnn.ConnectionStringSet cmd = New ADODB.Commandcmd.ActiveConnection = cnncmd.CommandType = adCmdStoredProccmd.CommandText = "stprMoveDataSet"Set param = cmd.CreateParameter("@DataSetID", adInteger, adParamInput, , stDataSet)cmd.Parameters.Append paramSet param = cmd.CreateParameter("@Destination", adChar, adParamInput, 1, stDestination)cmd.Parameters.Append paramrs.CursorType = adOpenStaticrs.CursorLocation = adUseClientrs.LockType = adLockOptimistic'rs.Open cmdSet rs = cmd.ExecuteIf 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 IfFor Each fld In rs.Fields    stMessage = stMessage & "| " & fld.Name & " / " & fld.Value & " |"Next fldstMessage = 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 |]