ValidateOnSet Property Example

This example uses the ValidateOnSet property to demonstrate how one might trap for errors during data entry. The ValidateData function is required for this procedure to run.

Sub ValidateOnSetX()

    Dim dbsNorthwind As Database
    Dim fldDays As Field
    Dim rstEmployees As Recordset

    Set dbsNorthwind = OpenDatabase("Northwind.mdb")

    ' Create and append a new Field object to the Fields 
    ' collection of the Employees table.
    Set fldDays = _
        dbsNorthwind.TableDefs!Employees.CreateField( _
        "DaysOfVacation", dbInteger, 2)
    fldDays.ValidationRule = "BETWEEN 1 AND 20"
    fldDays.ValidationText = _
        "Number must be between 1 and 20!"
    dbsNorthwind.TableDefs!Employees.Fields.Append fldDays

    Set rstEmployees = _
        dbsNorthwind.OpenRecordset("Employees")

    With rstEmployees

        Do While True
            ' Add new record.
            .AddNew

            ' Get user input for three fields. Verify that the 
            ' data do not violate the validation rules for any 
            ' of the fields.
            If ValidateData(!FirstName, _
                "Enter first name.") = False Then Exit Do
            If ValidateData(!LastName, _
                "Enter last name.") = False Then Exit Do
            If ValidateData(!DaysOfVacation, _
                "Enter days of vacation.") = False Then Exit Do

            .Update
            .Bookmark = .LastModified
            Debug.Print !FirstName & " " & !LastName & _
                " - " & "DaysOfVacation = " & !DaysOfVacation

            ' Delete new record because this is a demonstration.
            .Delete
            Exit Do
        Loop

        ' Cancel AddNew method if any of the validation rules 
        ' were broken.
        If .EditMode <> dbEditNone Then .CancelUpdate
        .Close
    End With

    ' Delete new field because this is a demonstration.
    dbsNorthwind.TableDefs!Employees.Fields.Delete _
        fldDays.Name
    dbsNorthwind.Close

End Sub

Function ValidateData(fldTemp As Field, _
    strMessage As String) As Boolean

    Dim strInput As String
    Dim errLoop As Error

    ValidateData = True
    ' ValidateOnSet is only read/write for Field objects in
    ' Recordset objects.
    fldTemp.ValidateOnSet = True

    Do While True
        strInput = InputBox(strMessage)
        If strInput = "" Then Exit Do
        ' Trap for errors when setting the Field value.
        On Error GoTo Err_Data
        If fldTemp.Type = dbInteger Then
            fldTemp = Val(strInput)
        Else
            fldTemp = strInput
        End If
        On Error GoTo 0
        If Not IsNull(fldTemp) Then Exit Do
    Loop

    If strInput = "" Then ValidateData = False
    
    Exit Function

Err_Data:

    If DBEngine.Errors.Count > 0 Then
        ' Enumerate the Errors collection. The description
        ' property of the last Error object will be set to
        ' the ValidationText property of the relevant
        ' field.
        For Each errLoop In DBEngine.Errors
            MsgBox "Error number: " & errLoop.Number & _
                vbCr & errLoop.Description
        Next errLoop
    End If
    
    Resume Next

End Function