Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations TouchToneTommy on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Trapping error codes from SQL server??

Status
Not open for further replies.

sparkbyte

Technical User
Sep 20, 2002
879
US
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.


Code:
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.


Code:
/******************************************************
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
 
Code:
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

Code:
Alter proc z

@Output varchar(250) output

As

Select * 
from Students


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

Return
 
Thanks PWise,

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

Thanks

John Fuhrman
 
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:
Code:
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


[pipe]
Daniel Vlas
Systems Consultant

 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top