[AccessD] adodb returning error code from stored procedures - CODE

The following is the code I currently use for executing stored procedures.  As I mentioned in the 
previous email, it works, but it does not return any value from the SP.  I have played around trying 
to make it do so but I think this is one of those cases where I could play for months and never get 
results without help.

Any assistance is greatly appreciated.

'---------------------------------------------------------------------------------------
' Procedure : CallADOStoredProc
' Author    : jwcolby
' Date      : 1/29/2009
' Purpose   : Calls a stored procedure passing in only "INPUT" parameters to the SP
'               SPs can have INPUT parameters and OUTPUT parameters.  Passing OUTPUT
'               parameters requires a different syntax when creating the parameter.
'               This function can only pass INPUT parameters.
'
'               I am leaving this function as is because much of the time that is all
'               that is required.  I will build another function to handle calls to
'               stored procedures that can handle both.
'---------------------------------------------------------------------------------------
'
Public Function CallADOStoredProcIn(strServerName As String, strDatabase As String, _
                                     ByVal SPName As String, _
                                     ParamArray Params() As Variant) As Boolean
   'Created by Charlotte Foust 9/30/2000
   'last modified 1/12/2001
   'Calls a saved query or stored procedure
   On Error GoTo Proc_err
   Dim varValue As Variant
   Dim strSQL As String
   Dim intLoop As Integer
   Dim varPrmType As Variant
   Dim lngRecords As Long


   Dim cnn As ADODB.Connection
   Dim cmd As ADODB.Command
   Dim errCurr As ADODB.Error
   Dim colErrs As ADODB.Errors
   Dim lTimeoutSeconds As Long

   Const ERR_OPER_ON_INVALID_CONNECTION = 3709
   Const ERR_RECORD_IS_DELETED = -2147467259
   Const ERR_Timeout = -2147217871

   Set cnn = New ADODB.Connection
   cnn.ConnectionString = mTrustedConnection(strServerName, strDatabase)
   cnn.CursorLocation = adUseClient

   'this simplifies accessing the errors
   'collection, which belongs to the
   'connection
   Set colErrs = cnn.Errors

   cnn.Open

   Set cmd = New ADODB.Command
   lTimeoutSeconds = 55000
   With cmd
     .ActiveConnection = cnn
     'this could also be written as
     'colErrs.Clear
     .ActiveConnection.Errors.Clear
     .CommandType = adCmdStoredProc
     .CommandText = SPName
     .CommandTimeout = lTimeoutSeconds

     For intLoop = LBound(Params) To UBound(Params)
       Select Case VarType(Params(intLoop))
         Case vbString
           varPrmType = adVarWChar
         Case vbLong
           varPrmType = adBigInt
         Case vbDate
           varPrmType = adDate
           'if SQL Server, use adDBTimeStamp
         Case vbInteger
           varPrmType = adSmallInt
         Case vbDouble
           varPrmType = adDouble
         Case vbSingle
           varPrmType = adSingle
         Case vbBoolean
           varPrmType = adBoolean
         Case vbCurrency
           varPrmType = adCurrency
            Case vbByte
           varPrmType = adUnsignedTinyInt
         Case vbNull
           varPrmType = Null
         Case Else
           'WARNING!  Not supported in ADO 2.5
           varPrmType = adVariant
       End Select
       If varPrmType = adVarWChar Then
         .Parameters.Append .CreateParameter( _
               "prm" & intLoop, varPrmType, adParamInput, Len(Params(intLoop)) + 2, Params(intLoop))
       Else
         'you have to create ALL the parameters
         .Parameters.Append .CreateParameter( _
               "prm" & intLoop, varPrmType, adParamInput, , Params(intLoop))
       End If 'varPrmType = adVarWChar
     Next intLoop
     .Execute RecordsAffected:=lngRecords, Options:=adCmdStoredProc
     CallADOStoredProcIn = True
   End With
Proc_exit:
   On Error Resume Next
   CallADOStoredProcIn = lngRecords
   Set cmd = Nothing
   Exit Function
Proc_err:
   'ADO errors and Jet errors aren't the same
   'collection, so this handles them differently
   If colErrs.Count > 0 Then
     'There are ADO errors
     For Each errCurr In colErrs
       Select Case errCurr
         Case ERR_OPER_ON_INVALID_CONNECTION
         Stop
           Resume Proc_exit
         Case "Timeout expired" 'Timeout
             Debug.Print "Command timeout in CallAdoStoredProcIn: " & lTimeoutSeconds & " Seconds"
             If lTimeoutSeconds > 60000 Then
                 MsgBox errCurr.Number & "--" _
                         & errCurr.Description & " (" _
                         & errCurr.Source & ")"
                 Resume Proc_exit
             Else
                 lTimeoutSeconds = lTimeoutSeconds * 2
                 Resume 0
             End If
         Case Else
             MsgBox errCurr.Number & "--" _
                     & errCurr.Description & " (" _
                     & errCurr.Source & ")"
             Resume Proc_exit
       End Select
     Next errCurr
     colErrs.Clear
   Else
     'there is an other error
     MsgBox Err.Number & "--" & Err.Description
     Resume Proc_exit
   End If
     Resume 0
End Function

-- 
John W. Colby
www.ColbyConsulting.com