locked
Getting return value from stored procedure with VBA RRS feed

  • Question

  •  

    I have a stored procedure in my sql database and for the life of me cannot figure out why I can't return an error number to my vba code. 
    
    The VBA code I have tried most recently is listed below along with the stored procedure code - I have gotten myself so turned around on this that now I am not even able to write to the table and I am always getting a number back of 547 at the point in the code where I call MsgBox rtnChkOpen. 
    
    What I really want to do is to send parameters to my stored procedure and return an error message if it fails. Does anyone have code that does this? I only want the error number or message returned. I don't have any other return values from this stored procedure. The way it works is I pass variables to the sp and it updates a table. If the table update fails it should send me an error number which I want to pick up in vba. 
    
    CREATE
    PROCEDURE [dbo].[spGS1ProcessTracking](
    @BUId Int
    , @TMCodeChar(2) 
    , @Tran_TypeChar(20) 
    , @ActionChar(20)
    , @ErrorNumIntOUTPUT
    )AS
    BEGIN
    Declare @ErrorMsgTxt Varchar(MAX);
    
    SET
    NOCOUNT ON;
    BEGIN
    TRY
    --Print 'Starting WriteMetric Transaction @ ' + cast(current_timestamp as varchar(50))
    Begin
    Transaction WriteMetric
    INSERT
    INTO dbo.GS1_PROC_METRICS(BU_ID, CNTRY_CD, TRAN_TYP, ACTN_ITM )
    
    SELECT
    TOP 1 @BUId
    , c.CNTRY_CD
    , @Tran_Type
    , @Action
    FROM
    dbo.GS1_CNTRY_CD_REF c
    WHERE
    c.CNTRY_CD= @TMCode
    IF
    @@ROWCOUNT=0
    -- @TMCode IS NULL or not recognized
    BEGIN
    INSERT INTO dbo.GS1_PROC_METRICS(BU_ID, CNTRY_CD, TRAN_TYP, ACTN_ITM)
    VALUES(@BUId, @TMCode, @Tran_Type, @Action)
    END
    Commit
    Transaction WriteMetric
    RETURN 0
    END
    TRY
    BEGIN
    CATCH
    Select @ErrorNum =@@ERROR
    Print
    'after select error. Error #='+casewhen @ErrorNumISNULLTHEN'NULL'ELSECAST(@ErrorNumASVARCHAR(10))
    END
    IF
    @ErrorNum > 0
    BEGIN
    print'Error Msg text='+casewhen @ErrorMsgTxtISNULLTHEN'NULL'ELSE @ErrorMsgTxtEND
    SELECT @ErrorMsgTxt=ERROR_MESSAGE()
    print'But ERROR_MESSAGE returns='+casewhen @ErrorMsgTxtISNULLTHEN'NULL'ELSE @ErrorMsgTxtEND
    RollbackTransaction WriteMetric
    print'Transaction WriteMetric Rolled back'
    Print'In the WriteMetric Error Routine. Rows affected='+cast(@@Rowcountasvarchar(10))
    RETURN @ErrorNum
    END
    END
    CATCH
    END
    
    Private Sub ProcessMetrics()
    Dim ADOcon As New ADODB.Connection
    Dim ADOcmd As New ADODB.Command
    Dim ADOrs As New ADODB.Recordset
    Dim ADOprm As ADODB.Parameter 'INPUT
    Dim ADOprm2 As ADODB.Parameter 'INPUT
    Dim ADOprmO1 As ADODB.Parameter 'INPUT
    Dim ADOprmO2 As ADODB.Parameter 'INPUT
    Dim ADOprmO3 As ADODB.Parameter 'OUTPUT Dim strSQL As String Dim lsqldatasourcename As String
    Dim sSteBUID As String 'input string
    Dim sSteTM As String 'input string
    Dim sSteTT As String
    Dim sSteAction As String
    Dim rtnChkOpen As Integer 'output integer sSteBUID = 2
    sSteTM = "test"
    sSteTT = "test"
    sSteAction = "test" Set ADOrs = CreateObject("ADODB.Recordset")
    Set ADOcon = CreateObject("ADODB.Connection") 'open connection
    ADOcon.ConnectionString = "Provider=SQLOLEDB; Data Source=USEagan6423D;Initial Catalog=SSBT;User ID=bigeldm; Password=; Trusted_Connection=yes"
    ADOcon.CursorLocation = adUseServer
    ADOcon.Open Set ADOcmd = New ADODB.Command
    Set ADOprm = ADOcmd.CreateParameter("@BUId", adBSTR, adParamInput, , sSteBUID)
    Set ADOprm2 = ADOcmd.CreateParameter("@TMCODE", adBSTR, adParamInput, , sSteTM)
    Set ADOprmO1 = ADOcmd.CreateParameter("@Tran_Type", adBSTR, adParamInput, , sSteTT)
    Set ADOprmO2 = ADOcmd.CreateParameter("@Action", adBSTR, adParamInput, , sSteAction)
    Set ADOprmO3 = ADOcmd.CreateParameter("@ErrorNum", adInteger, adParamReturnValue, 20) With ADOcmd
    .ActiveConnection = ADOcon
    .CommandType = adCmdStoredProc
    .CommandText = "spGS1ProcessTracking"
    .Parameters.Append ADOprm
    .Parameters.Append ADOprm2
    .Parameters.Append ADOprmO1
    .Parameters.Append ADOprmO2
    .Parameters.Append ADOprmO3
    End With ADOcmd.Execute rtnChkOpen = ADOcmd.Parameters("@ErrorNum") MsgBox rtnChkOpen ADOcon.Close
    Set userinfo = Nothing
    Set ADOcon = Nothing
    Set ADOcmd = Nothing
    Exit Sub
    End Sub

     

    Tuesday, November 22, 2011 12:39 PM