Trapping error codes from SQL server??

[sparkbyte]

OK, here is the problem.

I have some VBA CODE that verifies internal tracking numbers, but for some unknown reason it is not catching ALL mis-input numbers.
Granted a 300% improvement from the original CODE (not mine) is good but my boss would like to still eliminate the remaining errors.

Here is a before insert handler for filenumbers that works but, (and not sure why) it still allow from 3 to 9 errors through each month.

Private Sub FileNumber_BeforeUpdate(Cancel As Integer)
On Error GoTo Err_HandlerDim TrackingDate As Date
Dim dl As String
dl = vbNewLine & vbNewLineMe.TrackingDate = NowDim strFileNum As String
strFileNum = Me.FileNumberDim strFilePrefix As String
strFilePrefix = GetfileNumPrefix(strFileNum)Dim strFileSuffix As String
strFileSuffix = Mid(strFileNum, Len(GetfileNumPrefix(strFileNum)) + 1)If UCase(strFileNum) = UCase(".box.end.") Then
    Exit Sub
End IfIf IsNumeric(strFileNum) = False Or UCase(strFileNum) = UCase(".box.end.") ThenElse
    Cancel = True
    BeepWhirl
    strResult = MsgBox(Me.FileNumber & " is not a Valid File Number" & dl & _
               "The File Number is all Numeric and does not have a valid file prefix." & dl & dl & _
               "Please Correct the File Number ...", _
                vbExclamation + vbRetryCancel + vbDefaultButton1 + vbMsgBoxSetForeground + vbSystemModal, _
               "ERROR!")
        Select Case strResult
            Case vbOK, vbRetry, vbYes, vbNo
                Me.Undo
                Exit Sub
            Case vbCancel, vbAbort, vbIgnore
                Exit Sub
            Case Else
                Exit Sub
        End Select
End IfSelect Case Len(strFilePrefix)
    Case 1
        If IsNull(DLookup("[FileNumPrefix]", "tblFileNumPrefix", "[FileNumPrefix]='" & _
         strFilePrefix & "'")) = False Then
            If IsNumeric(strFileSuffix) = True And _
            (Len(strFileSuffix) = 8 Or Len(strFileSuffix) = 9) Then
            Else
            Cancel = True
            BeepWhirl
            strResult = MsgBox(Me.FileNumber & " is not a Valid File Number" & dl & _
                       "The File Number does not have a valid numeric file suffix." & dl & dl & _
                       "Please Correct the File Number ...", _
                       vbExclamation + vbRetryCancel + vbDefaultButton1 + vbMsgBoxSetForeground + vbSystemModal, _
                       "ERROR!")
                Select Case strResult
                    Case vbOK, vbRetry, vbYes, vbNo
                        Me.Undo
                        Exit Sub
                    Case vbCancel, vbAbort, vbIgnore
                        Exit Sub
                    Case Else
                        Exit Sub
                End Select
            End If
        Else
            Cancel = True
            BeepWhirl
            strResult = MsgBox(Me.FileNumber & " is not a Valid File Number" & dl & _
                       UCase(strFilePrefix) & " is not a valid Alien File prefix." & dl & dl & _
                       "Please Correct the File Number ...", _
                       vbExclamation + vbRetryCancel + vbDefaultButton1 + vbMsgBoxSetForeground + vbSystemModal, _
                       "ERROR!")
                Select Case strResult
                    Case vbOK, vbRetry, vbYes, vbNo
                        Me.Undo
                        Exit Sub
                    Case vbCancel, vbAbort, vbIgnore
                        Exit Sub
                    Case Else
                        Exit Sub
                End Select
        End If
    Case 2
        Cancel = True
        BeepWhirl
        strResult = MsgBox(Me.FileNumber & " is not a Valid File Number" & dl & _
                   "File Numbers do not have 2 character alpha prefixes." & dl & dl & _
                   "Please Correct the File Number ...", _
                    vbExclamation + vbRetryCancel + vbDefaultButton1 + vbMsgBoxSetForeground + vbSystemModal, _
                   "ERROR!")
            Select Case strResult
                Case vbOK, vbRetry, vbYes, vbNo
                    Me.Undo
                    Exit Sub
                Case vbCancel, vbAbort, vbIgnore
                    Exit Sub
                Case Else
                    Exit Sub
            End Select
    Case 3
        If IsNull(DLookup("[FileNumPrefix]", "tblFileNumPrefix", "[FileNumPrefix]='" & _
         strFilePrefix & "'")) = False Then
            If IsNumeric(strFileSuffix) = True Or _
            (Len(strFileSuffix) = 10 And Len(strFileSuffix) = 11) Then
            ' Continue
            Else
            Cancel = True
            BeepWhirl
            strResult = MsgBox(Me.FileNumber & " is not a Valid File Number" & dl & _
                       "The File Number does not have a valid 10 or 11 digit file suffix." & dl & dl & _
                       "Please Correct the File Number ...", _
                       vbExclamation + vbRetryCancel + vbDefaultButton1 + vbMsgBoxSetForeground + vbSystemModal, _
                       "ERROR!")
                Select Case strResult
                    Case vbOK, vbRetry, vbYes, vbNo
                        Me.Undo
                        Exit Sub
                    Case vbCancel, vbAbort, vbIgnore
                        Exit Sub
                    Case Else
                        Exit Sub
                End Select
            End If
        Else
            Cancel = True
            BeepWhirl
            strResult = MsgBox(Me.FileNumber & " is not a Valid File Number" & dl & _
                       UCase(strFilePrefix) & " is not a valid Reciept File prefix." & dl & dl & _
                       "Please Correct the File Number ...", _
                       vbExclamation + vbRetryCancel + vbDefaultButton1 + vbMsgBoxSetForeground + vbSystemModal, _
                       "ERROR!")
                Select Case strResult
                    Case vbOK, vbRetry, vbYes, vbNo
                        Me.Undo
                        Exit Sub
                    Case vbCancel, vbAbort, vbIgnore
                        Exit Sub
                    Case Else
                        Exit Sub
                End Select
        End IfEnd Select
    
If DCount("*", "tblTrackingTable", "FileNumber='" & Me!FileNumber & "' AND BoxNumber='" & Me!BoxNumber & "'") >= 1 Then
    Cancel = True
    BeepWhirl
            strResult = MsgBox("You have attempted to enter a duplicate " & _
                        "File Number for " & Me.BoxNumber.Value & dl & dl & _
                       "Please Correct the File Number ...", _
                       vbExclamation + vbRetryCancel + vbDefaultButton1 + vbMsgBoxSetForeground + vbSystemModal, _
                       "ERROR!")
                Select Case strResult
                    Case vbOK, vbRetry, vbYes, vbNo
                        Me.Undo
                        Exit Sub
                    Case vbCancel, vbAbort, vbIgnore
                        Exit Sub
                    Case Else
                        Exit Sub
                End Select
End Ifendit:
Exit SubErr_Handler:
If StandardErrors(Err) = False Then
    BeepWhirl
    MsgBox Err & ": " & Err.Description
End If
Resume enditEnd Sub

What I want to do is change the error handler to catch the error coming from SQL server and display either a custom message from the client (MS Access 2003) or the message from the SQL Server itself.

I have added some custom messages at the SQL server.

/******************************************************
Custom File Number error messages. (505XX)
*******************************************************/
--sp_dropmessage @msgnum = 50500
--go
--sp_dropmessage @msgnum = 50501sp_addmessage @msgnum = 50500,
@severity = 16,
@msgtext = N'The File Number you have entered does not meet existing criteria and will not be Accepted.'Gosp_addmessage @msgnum = 50501,
@severity = 16,
@msgtext = N'The File Number you have entered does not begin with a correct PREFIX and will not be Accepted.'

So essentially I need to know what CODE I can use to catch the error messages from SQL.

I am planning to change the main imput form from a bound form to an unbound main/sub form tied to a uSP (user stored procedure) and have the stored procedure do the validation rather than the VBA CODE.



Thanks

John Fuhrman

 

[PWise]

Option Compare Database
Option Explicit
Public Cnn As New ADODB.Connection
Dim cmd As New ADODB.Command
Function InitializeAdo()
If Cnn.State = adStateClosed Then
    Cnn.ConnectionTimeout = 0
    Cnn.Open CurrentProject.Connection
End If
End Function

Function ExecuteAdoOutput(AdoString As String, adoCommandType As Integer, ParamArray AdoPrams()) As ADODB.Command
'AdoPrams must have at least 1 value for the return value of a SP
Dim Prams As Integer
Dim A As Integer
InitializeAdo
cmd.CommandText = AdoString
Set cmd.ActiveConnection = Cnn
cmd.CommandType = adoCommandType
cmd.CommandTimeout = 0
For Prams = 0 To UBound(AdoPrams)
    cmd.Parameters(Prams) = AdoPrams(Prams)
Next Prams
cmd.Execute
Set ExecuteAdoOutput = cmd
End Function

Sub SQlOutput()
Dim Output As ADODB.Command
Set Output = ExecuteAdoOutput("z", 4, 0)
if Output("@output")>"" then

MsgBox Output("@output")
else
MsgBox "no errors"

end if
End Sub

Alter proc z

@Output varchar(250) output

As

Select * 
from Students


if @@rowcount <100
begin
Select @output ='Less then 100 Students'
end 

Return

 

[sparkbyte]

Thanks PWise,

I think I get the jist of this, but could you please explain its use?

Thanks

John Fuhrman

 

[danvlas]

I would use Try-Catch.
Set a varchar variable to the string you want, then just raiserror(@Variable, 16,1)

Then, in the Catch block:
select @Variable=Error_Message()
raiserror(@Variable, 16,1)

Something like:

Begin Try
--code to check certain conditions
select @Variable = 'Whatever text you like here'
raiserror(@Variable, 16,1)
End Try

Begin Catch
select @Variable=error_message()
raiserror(@Variable, 16,1)
End Catch

This way, the client (VBA) will get the error you want through ADO.

HTH



Daniel Vlas
Systems Consultant