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