Validating data before it get submitted on a bound form is easy enough. Each control should have its own logic and you can do things based on it passing some predefined rule. But if you have unbound controls/and unbound form needing validation it is a little trickier.
I wrote this to call out to users invalid data. It really only checks for NULLS (i.e. if a field was marked as required it needs to have something in it). When it encounters invalid data it makes that control have a red border. When the data are deemed to be valid it switches the border back to whatever it was when the form loaded.
You can Initialize it like thisDim validator As Validation
Private Sub Form_Load()
Dim controlsNeedingValidation As New Collection
controlsNeedingValidation.Add lstAnswerOptions
controlsNeedingValidation.Add cboPerson
Set validator = New Validation
validator.SetValidationDictionary (controlsNeedingValidation)
End Sub
or
Dim validator As Validation
Private Sub Form_Load()
Set validator = New Validation
validator.SetValidationDicToReqControls Me.RecordsetClone, Me.Controls
End Sub
In either one you can set the invalid formats like
Dim invalidFormats As New ControlFormat
invalidFormats.BorderColor = RGB(255, 0, 0)
invalidFormats.BorderStyle = 1
invalidFormats.BorderWidth = 1
validator.invalidFormats = invalidFormatsBorderStyle, BorderWidth, and BorderColor can be whatever you want them to be.
Then whenever you go to save you have all your save code inside an IF block that is conditional on this returning true
If validator.ValidateControls Then
' Save record
End If
' else don't save the recordThen if you switch records or for whatever reason need to restore the defaults you can call this
validator.RestoreOriginalControlsStates
Here's the full code for the Validation class. There is another supporting class I made called ControlFormat
which holds the original states of the controls which get formatted as
"invalid". This is necessary for switching back to however they were
originally formatted once the user enters good data. Right now my class
only has boarder width, color, and style. You can expand that of course.
Option Compare Database
Option Explicit
Private p_InvalidFormats As ControlFormat
Private p_ValidationDictionary As Dictionary
Private Sub Class_Initialize()
Set p_InvalidFormats = New ControlFormat
invalidFormats.BorderColor = RGB(255, 0, 0)
invalidFormats.BorderStyle = 2
invalidFormats.BorderWidth = 1 ' 1= Solid, 0 = transparent
End Sub
Public Function ValidateControls() As Boolean
Dim allControlsAreValid As Boolean
allControlsAreValid = True 'default state unless deemed otherwise
Dim origState As ControlFormat
Dim ctrl As Control, c
For Each c In p_ValidationDictionary.Keys()
Set origState = p_ValidationDictionary(c)
Set ctrl = c
If Not ValidateControl(ctrl, origState) Then
allControlsAreValid = False
End If
Next c
ValidateControls = allControlsAreValid
End Function
Private Function RestoreOriginalControlState(ctrl As Control, originalControlState As ControlFormat)
ctrl.BorderColor = originalControlState.BorderColor
ctrl.BorderStyle = originalControlState.BorderStyle
ctrl.BorderWidth = originalControlState.BorderWidth
End Function
Public Function RestoreOriginalControlsStates()
Dim origState As ControlFormat
Dim ctrl As Control, c
For Each c In p_ValidationDictionary.Keys()
Set origState = p_ValidationDictionary(c)
Set ctrl = c
RestoreOriginalControlState ctrl, origState
Next c
End Function
Private Function ValidateControl(ctrl As Control, originalControlState As ControlFormat) As Boolean
If IsNull(ctrl) Then
ctrl.BorderColor = invalidFormats.BorderColor
ctrl.BorderWidth = invalidFormats.BorderStyle
ctrl.BorderStyle = invalidFormats.BorderWidth
ValidateControl = False
Else
RestoreOriginalControlState ctrl, originalControlState
ValidateControl = True
End If
End Function
Public Function SetValidationDictionary(coll As Collection) As Dictionary
Set p_ValidationDictionary = New Dictionary
Dim c, origState As ControlFormat
For Each c In coll
Set origState = New ControlFormat
origState.BorderColor = c.BorderColor
origState.BorderStyle = c.BorderStyle
origState.BorderWidth = c.BorderWidth
ValidationDictionary.Add c, origState
Next c
Set SetValidationDictionary = ValidationDictionary
End Function
Public Function SetValidationDicToReqControls(rs As DAO.Recordset, ctrls As Controls) As Dictionary
Set SetValidationDicToReqControls = SetValidationDictionary(GetRequiredControls(rs, ctrls))
End Function
Private Function GetRequiredControls(rs As DAO.Recordset, ctrls As Controls) As Collection
Dim ctrl As Control, fld As DAO.Field
Dim requiredControls As New Collection
Dim ctrlsWithCtrlSrcs As Dictionary
Set ctrlsWithCtrlSrcs = ControlTypesWithControlSources
For Each fld In rs.Fields 'search each field
If fld.Required Then 'if that field is required
For Each ctrl In ctrls 'then find the control that field is bound to
If ctrlsWithCtrlSrcs.Exists(TypeName(ctrl)) Then
If ctrl.ControlSource = fld.Name Then 'and save it
requiredControls.Add ctrl
Debug.Print ctrl.Name
End If
End If
Next ctrl
End If
Next fld
Set GetRequiredControls = requiredControls
End Function
Private Function ControlTypesWithControlSources() As Dictionary
Dim dicControlTypesWithControlSources As New Dictionary
dicControlTypesWithControlSources.Add "TextBox", "TextBox"
dicControlTypesWithControlSources.Add "ComboBox", "ComboBox"
dicControlTypesWithControlSources.Add "Checkbox", "Checkbox"
dicControlTypesWithControlSources.Add "Listbox", "Listbox"
Set ControlTypesWithControlSources = dicControlTypesWithControlSources
End Function
Public Property Get ValidationDictionary() As Dictionary
Set ValidationDictionary = p_ValidationDictionary
End Property
Public Property Get invalidFormats() As ControlFormat
Set invalidFormats = p_InvalidFormats
End Property
Public Property Let invalidFormats(ByVal vNewValue As ControlFormat)
Set p_InvalidFormats = vNewValue
End Property
ControlFormat
Private p_borderStyle As Long
Private p_borderColor As Long
Private p_BorderWidth As Long
Public Property Get BorderStyle() As Long
BorderStyle = p_borderStyle
End Property
Public Property Let BorderStyle(ByVal vNewValue As Long)
p_borderStyle = vNewValue
End Property
Public Property Get BorderColor() As Long
BorderColor = p_borderColor
End Property
Public Property Let BorderColor(ByVal vNewValue As Long)
p_borderColor = vNewValue
End Property
Public Property Get BorderWidth() As Long
BorderWidth = p_BorderWidth
End Property
Public Property Let BorderWidth(ByVal vNewValue As Long)
p_BorderWidth = vNewValue
End Property