Daily Access Tips

If you’re new here, you may want to subscribe to my RSS feed. Thanks for visiting!

The following code subroutine called ‘SetValidatorEventHandlers’ is place in the OnOpen Event of every form you want Microsoft Access validation of form data. It will add the call to the Validator function from OnGotFocus Events of all visible text box, combo boxes, and listboxes on your form. If you already are planning to place other code in the OnGotFocus Events of these controls on your form, then you will want to reference the custom validation function call ‘Validator’ in the OnGotFocus subroutine for each control that you will want to trigger this code.

Place in the ‘Tag’ property of each control you want to validate the following symbols and characters:

• *n – The form control may not be left empty.
• *d – The control must contain a valid date.
• *+ – The control must have an amount greater than zero.
• *@ -The control must be a valid email address.

Other types of validation may be added by you as needed. You may may combine these pairs of characters if needed.

If you do not wish to refer to the form’s controls actual name in your validation message to the user, you may specify a preferred alternative name by adding this to the end of the tag property.
~My Preferred Control Name
Replace ‘My Preferred Control Name’ with the control name you want the user to see.

Here’s the code:

Public Sub SetValidatorEventHandlers(frm As Form)

‘Runing this routine from the OnOpen event of any form

‘using Call SetValidatorEventHandlers(Me)
‘will replace any OnGotFocus event code with a call
‘to the Validator function.
Public Sub SetValidatorEventHandlers(frm As Form)
‘Runing this routine from the OnOpen event of any form
‘using Call SetValidatorEventHandlers(Me)
‘will replace any OnGotFocus event code with a call
‘to the Validator function.
On Error GoTo errline
Dim ctl As Control, tagstr As String
For Each ctl In frm.Controls
Select Case ctl.ControlType
Case acTextBox, acComboBox, acListBox
If ctl.Visible = True Then
ctl.OnGotFocus = “=Validator()”
End If
Case acCommandButton
If ctl.Visible = True And Len(ctl.Tag) > 0 Then
Select Case ctl.Tag
Case “*Close”
ctl.OnClick = “=CommandButtonCodeActiveForm(” & Chr(34) & “*Close” & Chr(34) & “)”
Case “*First”
ctl.OnClick = “=CommandButtonCodeActiveForm(” & Chr(34) & “*First” & Chr(34) & “)”
Case “*Previous”
ctl.OnClick = “=CommandButtonCodeActiveForm(” & Chr(34) & “*Previous” & Chr(34) & “)”
Case “*Next”
ctl.OnClick = “=CommandButtonCodeActiveForm(” & Chr(34) & “*Next” & Chr(34) & “)”
Case “*Last”
ctl.OnClick = “=CommandButtonCodeActiveForm(” & Chr(34) & “*Last” & Chr(34) & “)”
Case “*New”
ctl.OnClick = “=CommandButtonCodeActiveForm(” & Chr(34) & “*New” & Chr(34) & “)”
Case Else
End Select
End If

Case Else
End Select
Next
exitline:
Exit Sub
errline:
Select Case Err.Number
Case Else
MsgBox “There was an error in the program.  Please notify database administrator of the following error: ” & Chr(10) & “Error Number: ” & Err.Number & Chr(10) & Err.Description, vbCritical, “Please write this error down and note what you were doing at the time.”
GoTo exitline
Resume Next
End Select
End Sub

Public Function CommandButtonCodeActiveForm(CommandTagAction as String)

On Error GoTo errline
If Validator() = True Then
Select Case CommandTagAction
Case “*Close”
DoCmd.Close acForm, Screen.ActiveForm.Name
Case “*First”
DoCmd.GoToRecord , , acFirst
Case “*Previous”
DoCmd.GoToRecord , , acPrevious
Case “*Next”
DoCmd.GoToRecord , , acNext
Case “*Last”
DoCmd.GoToRecord , , acLast
Case “*New”
DoCmd.GoToRecord , , acNewRec
Case Else
End Select
End If
exitline:
Exit Function
errline:
Select Case Err.Number
Case 2105 ‘Impossible navigation attempt
Resume Next
Case Else
MsgBox “There was an error in the program.  Please notify database administrator of the following error: ” _
& Chr(10) & “Error Number: ” & Err.Number & Chr(10) & Err.Description, vbCritical, _
“Please write this error down and note what you were doing at the time.”
GoTo exitline
End Select
End Function

Public Function Validator() As Boolean

On Error GoTo errline
Dim TabOrderedControls As New Collection
Dim ControlNames() As String
Dim i As Long
Dim ctl As Control
Dim CurrentControlTabIndex As Long
Dim strFailedCtlName As String
Dim bolFailedValidation As Boolean
Dim strErrorMsg As String
‘Is Form ready to be validated by this microsoft access validation code
If Screen.ActiveForm.NewRecord And Screen.ActiveForm.Dirty = False Then
Exit Function
End If
ReDim ControlNames(Screen.ActiveForm.Controls.Count)
‘Save any pending edits
If Screen.ActiveForm.Dirty Then
Screen.ActiveForm.Dirty = False
End If
‘Where are we in the tab order

‘If pressing a command button, consider we are to validate all tab order controls (Not just ones earlier than tab index of the command button.)
If Screen.ActiveControl.ControlType = acCommandButton Then
CurrentControlTabIndex = 999
Else
CurrentControlTabIndex = Screen.ActiveControl.TabIndex
End If

For Each ctl In Screen.ActiveForm.Controls
Select Case ctl.ControlType
Case acTextBox, acComboBox, acListBox
‘Set yellow backround to white, if previously set to yellow
ctl.BackColor = -2147483643
‘Populate the ‘ControlNames’ array by control tab order
If ctl.TabIndex < CurrentControlTabIndex Then
ControlNames(ctl.TabIndex) = ctl.Name
End If
Case Else
’skip
End Select
Next
‘Populate collection ‘TabOrderedControls’ using ControlNames array.
For i = 0 To UBound(ControlNames)
If ControlNames(i) <> “” Then
TabOrderedControls.Add Screen.ActiveForm.Controls(ControlNames(i))
End If
Next i
‘Start validation
For Each ctl In TabOrderedControls
”Test for null (empty) on form control
If InStr(1, ctl.Tag, “*n”, 1) > 0 Then
If IsNull(ctl.Value) Then
strErrorMsg = ” needs to be filled in.”
bolFailedValidation = True
GoTo ValidatorFalure
End If
End If
‘Test for a valid date
If InStr(1, ctl.Tag, “*d”, 1) > 0 Then
If Not IsDate(ctl.Value) Then
strErrorMsg = ” must contain a valid date.”
bolFailedValidation = True
GoTo ValidatorFalure
End If
End If
‘Test for a value greater than zero
If InStr(1, ctl.Tag, “*+”, 1) > 0 Then
If Not (ctl.Value) > 0 Then
strErrorMsg = ” amount must be greater than zero.”
bolFailedValidation = True
GoTo ValidatorFalure
End If
End If
‘Test for a valid email address symbol
If InStr(1, ctl.Tag, “*@”, 1) > 0 Then
If Not InStr(1, ctl.Value, “@”, 1) > 0 Then
strErrorMsg = ” amount must be greater than zero.”
bolFailedValidation = True
GoTo ValidatorFalure
End If
End If
‘You may add additional validation here:
ValidatorFalure:
If bolFailedValidation = True Then
ctl.BackColor = 65535 ‘yellow
‘~ The tilde means there is an alternative preferred control name
‘After any tilde ~ there should be no other validation * asterisk symbols
If Not InStr(1, ctl.Tag, “~”, 0) = 0 Then
strFailedCtlName = Trim(Mid(ctl.Tag, InStr(1, ctl.Tag, “~”, vbBinaryCompare) + 1)) ‘Retreive prefered control name if different than real control name.
End If
If Len(strFailedCtlName) = 0 Then
MsgBox “The ” & ctl.Name & strErrorMsg, vbInformation, ctl.Name & ” missing value…”
Else
MsgBox “The ” & strFailedCtlName & strErrorMsg, vbInformation, strFailedCtlName & ” missing value…”
End If
ctl.SetFocus
If ctl.ControlType = acComboBox Then ‘If combo box, drop down the pick list.
ctl.Dropdown
End If
Validator = False
Exit Function
End If
Next ctl
Validator = True
exitline:
If Not TabOrderedControls Is Nothing Then
Set TabOrderedControls = Nothing
End If
Exit Function
errline:
Select Case Err.Number
‘Form window not visible yet to see Screen.ActiveControl
‘(Only needed when setting event handlers by code
‘using the ‘SetValidatorEventHandlers’ function.)
Case 2475
Resume exitline
Case Else
MsgBox “There was an error in the program. Please notify database administrator of the following error: ” _
& Chr(10) & “Error Number: ” & Err.Number & Chr(10) & Err.Description, vbCritical, _
“Please write this error down and note what you were doing at the time.”
GoTo exitline
End Select
End Function

Here is the demonstration video tutorial:

from youtube