Validating Form Module

[oxicottin]

Hello, I found this module and it works great except I cant get it to work without using a "Close Button" to triger the code if closed. Im using the default close that the report has and I dont want to use a close button so how could I triger the validation when either the form is closed OR the DB window is closed with the form open. Thanks!

Im a beginer so please explain....

'[URL unfurl="true"]http://www.dailyaccesstips.com/code-for-microsoft-access-validation-of-data/[/URL]

'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.

'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 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.


Public Sub SetValidatorEventHandlers(frm As Form)
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

Thanks,
SoggyCashew.....

 

[traingamer]

Run your code from the [blue]Unload[/blue] event in your form.

Greg
People demand freedom of speech as a compensation for the freedom of thought which they seldom use. Kierkegaard

 

[oxicottin]

Greg, I tried it in the unload of the form and the DB still can close without running the validation. I had also ran into another problem. I changed my form to using a close button control and took off the default X button and everyting works fine except if I create a new record then the close button wont do anything even if I filled out the required data BUT if I open a previous record that already has been filled out it closes with no problems and the validation works because I removed a required field and the pop up came up. So I think mabe it has to do with focus since thats what the mod looks like its based on. Any sugestions? Thanks!

Thanks,
SoggyCashew.....

 

[oxicottin]

Update: It does work on a new record but only if I start entering data into the form then if I press the close button it will prompt that I have fields that need filled out.

Thanks,
SoggyCashew.....