VBA - How to run SQL function

[sparkbyte]

Sorry for the cross post from the ADP forum but, I am not sure which forum will be able to address this best.

I am trying to run a SQL function that validates file numbers prior to inserting the row into the table.

Here is the SQL function.

/****** Object:  UserDefinedFunction [dbo].[IsFileNumberValid]    Script Date: 10/19/2010 10:23:10 ******/
SET ANSI_NULLS ON
GO
SET QUOTED_IDENTIFIER ON
GO
ALTER Function [dbo].[IsFileNumberValid]
    (@FileNumber VarChar(15))
Returns Bit
As
Begin
    Declare @Prefix VarChar(15)
    Declare @IsValid Bit

    Select @IsValid = 0,
           @Prefix = Left(@FileNumber, PatIndex('%[^a-z.]%', @FileNumber + '1')-1)

    If (@FileNumber like '[a-zA-Z][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]' 
        OR @FileNumber like '[a-zA-Z][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]' 
        OR @FileNumber like '[a-zA-Z][a-zA-Z][a-zA-Z][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]' 
        OR @FileNumber like '[a-zA-Z][a-zA-Z][a-zA-Z][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]' 
        OR @FileNumber like '.BOX.END.')
        If Exists(Select 1 from tblFileNumPrefix Where FileNumPrefix = @Prefix)
            Set @IsValid = 1

    Return @IsValid
End

And here is some sample code to show what I am trying to do.
(NON FUNCTIONAL).

If DoCmd.OpenFunction(IsFileNumberValid,acViewNormal,acReadOnly) me.FileNumber <> 1 Then
    Cancel = True
    BeepWhirl
            strResult = MsgBox("The File Number you have Entered is Invalid." & _
                       "Please Correct the File Number ...", _
                       vbExclamation + vbOKOnly, _
                       "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

The reason for doing this is because the curent VBA code is allowing impropperly formatted file numbers into the tracking table.

Here is the current VBA code just in case.

On Error GoTo Err_Handler

Dim TrackingDate As Date
Dim dl As String
dl = vbNewLine & vbNewLine

Me.TrackingDate = Now

Select Case Len(Me.FileNumber)
    Case Is < 7
         Cancel = True
         BeepWhirl
         MsgBox Me.FileNumber & " is not a Valid File Number" & dl & _
                "Please Correct the File Number ...", _
                vbExclamation + vbOKOnly, _
                "ERROR!"
         Me.Undo
         Exit Sub
    
    Case 8 To 13
        If IsAlpha(left(Me.FileNumber, 3)) = True Then
                Select Case UCase(left(Me.FileNumber, 3))
                    Case "SRC", "LIN", "WAC", "EAC", "MSC"
                        If IsNumeric(Mid(Me.FileNumber, 4)) = True Then
                            'Continue
                        Else
                            Cancel = True
                            BeepWhirl
                            strResult = MsgBox(Me.FileNumber & " is not a Valid File Number" & dl & _
                                       "Please Correct the File Number ...", _
                                       vbExclamation + vbOKOnly, _
                                       "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 Else
                        Cancel = True
                        BeepWhirl
                        strResult = MsgBox(Me.FileNumber & " is not a Valid File Number" & dl & _
                                   "Please Correct the File Number ...", _
                                   vbExclamation + vbOKOnly, _
                                   "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 Select
        ElseIf IsAlpha(left(Me.FileNumber, 1)) = True Then
                Select Case UCase(left(Me.FileNumber, 1))
                    Case "A", "T", "S", "W", "C"
                        If IsNumeric(Mid(Me.FileNumber, 2)) = True Then
                            'Continue
                        Else
                            Cancel = True
                            BeepWhirl
                            strResult = MsgBox(Me.FileNumber & " is not a Valid File Number" & dl & _
                                       "Please Correct the File Number ...", _
                                       vbExclamation + vbOKOnly, _
                                       "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 Else
                        Cancel = True
                        BeepWhirl
                        strResult = MsgBox(Me.FileNumber & " is not a Valid File Number" & dl & _
                                   "Please Correct the File Number ...", _
                                   vbExclamation + vbOKOnly, _
                                   "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 Select
        ElseIf UCase(Me.FileNumber) = UCase(".box.end.") Then
                'End of box processing
            Else
                Cancel = True
                BeepWhirl
                strResult = MsgBox(Me.FileNumber & " is not a Valid File Number" & dl & _
                           "Please Correct the File Number ...", _
                           vbExclamation + vbOKOnly, _
                           "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 Is > 13
        Cancel = True
        BeepWhirl
            MsgBox Me.FileNumber & " is not a Valid File Number" & dl & _
                   "Please Correct the File Number ...", _
                   vbExclamation + vbOKOnly, _
                   "ERROR!"
            Me.Undo
           Exit Sub
    End 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 & vbCrLf & _
                       "Please Correct the File Number ...", _
                       vbExclamation + vbOKOnly, _
                       "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

endit:
Exit Sub

Err_Handler:
 If StandardErrors(Err) = False Then
    BeepWhirl
    MsgBox Err & ": " & Err.Description
 End If
Resume endit

End Sub

Thanks

John Fuhrman



Thanks

John Fuhrman

 

[PWise]

run the function as a recordset

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 ExecuteAdoRS(AdoString As String, adoCommandType As Integer, ParamArray AdoPrams()) As ADODB.Recordset
'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)
    'Debug.Print cmd.Parameters.Item(Prams).Name, Prams, cmd.Parameters.Item(Prams).Value
Next Prams
Set ExecuteAdoRS = cmd.Execute(a)
If adoCommandType = 4 Then AdoPrams(0) = cmd(0)
End Function

dim rst as recordset
Set rst =ExecuteAdoRS("select [dbo].[IsFileNumberValid](filenumber) as IsFileNumberValid",1)
debug.print rst!IsFileNumberValid

 

[sparkbyte]

OK, I see what you have done in your answer but, I am unsure how to use it.


Thanks!!!!!!

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 ExecuteAdoRS(AdoString As String, adoCommandType As Integer, ParamArray AdoPrams()) As ADODB.Recordset
'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)
    'Debug.Print cmd.Parameters.Item(Prams).Name, Prams, cmd.Parameters.Item(Prams).Value
Next Prams
Set ExecuteAdoRS = cmd.Execute(a)
If adoCommandType = 4 Then AdoPrams(0) = cmd(0)
End Function

with ExecuteAdoRS("select [dbo].[IsFileNumberValid](filenumber) as IsFileNumberValid",1)
    if !IsFileNumberValid<>1
       Cancel = True
       BeepWhirl
       strResult = msgbox......
       .......
       Select Case strResult
             case....
       end select
    end if
end with
[code]