Validating via VBA Function

WatsonDyar

Registered User.
Local time
Today, 14:32
Joined
Aug 12, 2014
Messages
50
I have the following function that validates on on form before update & unload:

PHP:
Public Function Valid() As Boolean
On Error GoTo Err_Handler

    Dim strPrompt As String
    Dim strWhere As String

    If Me.Dirty Then
        If IsNull(Me.txtLastName) Then
            strPrompt = "Last name is required." & vbCrLf & _
            "To continue WITHOUT saving this record, select 'Cancel' on the Registration form."
            MsgBox strPrompt, vbInformation, "Missing Information"
            Me.txtLastName.SetFocus
            Valid = False
            GoTo Exit_Proc
        End If

        If IsNull(Me.txtFirstName) Then
            strPrompt = "First name is required." & vbCrLf & _
            "To continue WITHOUT saving this record, select 'Cancel' on the Registration form."
            MsgBox strPrompt, vbInformation, "Missing Information"
            Me.txtFirstName.SetFocus
            Valid = False
            GoTo Exit_Proc
        End If

        If IsNull(Me.txtRank) Then
            strPrompt = "Rank/Grade is required. Select 'Other' if the appropriate rank is not available." & vbCrLf & _
            "To continue WITHOUT saving this record, select 'Cancel' on the Registration form."
            MsgBox strPrompt, vbInformation, "Missing Information"
            Me.txtRank.SetFocus
            Valid = False
            GoTo Exit_Proc
        End If

        If IsNull(Me.txtOfficialEmail) Then
            strPrompt = "Your military/official enterprise email is required." & vbCrLf & _
            "To continue WITHOUT saving this record, select 'Cancel' on the Registration form."
            MsgBox strPrompt, vbInformation, "Missing Information"
            Me.txtOfficialEmail.SetFocus
            Valid = False
            GoTo Exit_Proc
        End If
    
        If IsNull(Me.txtOfficialPhone) Then
            strPrompt = "Your official/DSN phone is required." & vbCrLf & _
            "To continue WITHOUT saving this record, select 'Cancel' on the Registration form."
            MsgBox strPrompt, vbInformation, "Missing Information"
            Me.txtOfficialPhone.SetFocus
            Valid = False
            GoTo Exit_Proc
        End If

        If IsNull(Me.txtDutyTitle) Then
            strPrompt = "Duty title is required." & vbCrLf & _
            "To continue WITHOUT saving this record, select 'Cancel' on the Registration form."
            MsgBox strPrompt, vbInformation, "Missing Information"
            Me.txtDutyTitle.SetFocus
            Valid = False
            GoTo Exit_Proc
        End If

        If IsNull(Me.txtArrivalDate) Then
            strPrompt = "Enter the approximate date you arrived to your current unit." & vbCrLf & _
            "To continue WITHOUT saving this record, select 'Cancel' on the Registration form."
            MsgBox strPrompt, vbInformation, "Missing Information"
            Me.txtArrivalDate.SetFocus
            Valid = False
            GoTo Exit_Proc
        End If

        If IsNull(Me.txtDepartureDate) Then
            strPrompt = "Enter the approximate date you expect to depart (PCS, ETS, etc) your current unit." & vbCrLf & _
            "To continue WITHOUT saving this record, select 'Cancel' on the Registration form."
            MsgBox strPrompt, vbInformation, "Missing Information"
            Me.txtDepartureDate.SetFocus
            Valid = False
            GoTo Exit_Proc
        End If

        If IsNull(Me.txtUIC) Then
            strPrompt = "Provide your UIC. If appropriate, select 'Not sure' or 'Other'" & vbCrLf & _
            " and provide your unit details in the 'Remarks' section." & vbCrLf & _
            "To continue WITHOUT saving this record, select 'Cancel' on the Registration form."
            MsgBox strPrompt, vbInformation, "Missing Information"
            Me.txtUIC.SetFocus
            Valid = False
            GoTo Exit_Proc
        End If

        If IsNull(Me.txtDepartureDate) Then
            strPrompt = "Enter the approximate date expect to depart (PCS, ETS, etc) your current unit." & vbCrLf & _
            "To continue WITHOUT saving this record, select 'Cancel' on the Registration form."
            MsgBox strPrompt, vbInformation, "Missing Information"
            Me.txtDepartureDate.SetFocus
            Valid = False
            GoTo Exit_Proc
        End If

        If IsNull(Me.cboDateSelect) Then
            strPrompt = "You must register for a class date." & vbCrLf & _
            "To continue WITHOUT saving this record, select 'Cancel' on the Registration form."
            MsgBox strPrompt, vbInformation, "Missing Information"
            Me.cboDateSelect.SetFocus
            Valid = False
            GoTo Exit_Proc
        End If

        If Me.NewRecord Then
            strWhere = "OfficialEmail = '" & Me.txtOfficialEmail & "'"
        Else
            strWhere = "OfficialEmail = '" & Me.txtOfficialEmail & "' AND Student_ID <> " & Me.Student_ID
        End If
        If DCount("Student_ID", "t_MRTT_RosterStudent", strWhere) > 0 Then
            strPrompt = "The email you entered has already been used in a class registration." & vbCrLf & _
            "Only one registration per student is authorized." & vbCrLf & _
            "To continue WITHOUT saving this record, select 'Cancel' on the Registration form."
            MsgBox strPrompt, vbInformation, "Invalid Information"
            Me.txtOfficialEmail.SetFocus
            Valid = False
            GoTo Exit_Proc
        End If

    End If

    Valid = True

Exit_Proc:
    On Error Resume Next
    Exit Function

Err_Handler:
    MsgBox Err.Number & " " & Err.Description, vbCritical, "Valid()"
    Valid = False
    Resume Exit_Proc
End Function

Private Sub Form_BeforeUpdate(Cancel As Integer)
On Error GoTo Err_Handler

    If Not Valid() Then
        Cancel = True
        GoTo Exit_Proc
    End If

Exit_Proc:

    On Error Resume Next
    Exit Sub

Err_Handler:

    MsgBox Err.Number & " " & Err.Description, vbCritical, "Form_BeforeUpdate()"
    Resume Exit_Proc

End Sub

I want this to run when I select another cmd button with the "On Click". Is this possible? :banghead:
 
Yes. You add an Onclick event to whatever control you want. Then in that code section you add calls to your function. It would look something like this:

Code:
Private Sub YourControl_Click()
    ' handles click on YourControl

ret=Valid()


End Sub
 
Thank you! So simple....
 
note that the valid check on before unload will not work. (your form will return dirty = false, and the code will therefore not do anything)

the record is either saved or the save fails before the unload event happens. Unload just unloads a clean form.
 

Users who are viewing this thread

Back
Top Bottom