Firstly you should as far as possible include validation rules in the table definition. You might also be able to apply CHECK CONSTRAINTs to the table for conditions which cannot be covered by a validation rule.
For validation at form level you not only need to set the return value of the form's BeforeUpdate event procedure's Cancel argument to True, but also that of the Unload event procedure to True to prevent the form closing without the user having the opportunity
to correct the validation infringements. To do this you need to use a Boolean module level variable whose value allows the form to close, and assign a value to this variable which prevents the form closing wherever a validation infringement is encountered
elsewhere in the code. The variable's value needs to be reassigned when the validation infringements have been corrected of course, in order to allow the form to close.
You might like to take a look at SaveDemo.zip in my public databases folder at:
https://onedrive.live.com/?cid=44CC60D7FEA42912&id=44CC60D7FEA42912!169
Note that if you are using an earlier version of Access you might find that the colour of some form objects such as buttons shows incorrectly and you will need to amend the form design accordingly.
If you have difficulty opening the link copy its text (NB, not the link location) and paste it into your browser's address bar.
In this simple little demo file code in the form's module does as described above. It also ensures that the form can only be closed via a Close button (equivalent to your Return button, but without moving to another form) by enabling/disabling the relevant
buttons on the basis of the form's current state. The form also includes validation at control level. The full code for the form's module is:
Option Compare Database
Option Explicit
Dim blnSaved As Boolean
Dim blnAllowClose As Boolean
Dim blnAllowUndo As Boolean
Private Sub cboFindContact_AfterUpdate()
Const CANNOT_MOVE_TO_RECORD = 3709
Const MESSAGE_TEXT = "Cannot move to record. Save or undo current record first."
Dim ctrl As Control
Set ctrl = Me.ActiveControl
If Not IsNull(ctrl) Then
If ctrl = 0 Then
Me.FilterOn = False
Else
On Error Resume Next
Me.Filter = "ContactID = " & ctrl
Select Case Err.Number
Case CANNOT_MOVE_TO_RECORD
'iinform user and set combo box to current contact
MsgBox MESSAGE_TEXT, vbInformation, "Warning"
ctrl = Me.ContactID
Case 0
' no error
Me.FilterOn = True
Case Else
' unknown error - inform user
MsgBox Err.Description, vbExclamation, "Error"
End Select
End If
End If
End Sub
Private Sub cmdClose_Click()
' set variable to allow form to close
blnAllowClose = True
DoCmd.Close acForm, Me.Name
End Sub
Private Sub cmdSave_Click()
Const MESSAGETEXT = "Save record?"
If Me.Dirty Then
' if user confirms set variable to True and attempt to save record
If MsgBox(MESSAGETEXT, vbQuestion + vbYesNo, "Confirm") = vbYes Then
blnSaved = True
On Error Resume Next
RunCommand acCmdSaveRecord
' if record cannot be saved set variable to False
If Err <> 0 Then
blnSaved = False
Else
' disable buttons
' move focus to another control first
Me.FirstName.SetFocus
Me.cmdSave.Enabled = False
Me.cmdUndo.Enabled = False
Me.cmdClose.Enabled = True
End If
Else
blnSaved = False
End If
End If
End Sub
Private Sub cmdUndo_Click()
blnAllowUndo = True
' undo edits
Me.Undo
blnAllowUndo = False
' disable buttons
' move focus to another control first
Me.FirstName.SetFocus
Me.cmdSave.Enabled = False
Me.cmdUndo.Enabled = False
Me.cmdClose.Enabled = True
End Sub
Private Sub DoB_GotFocus()
If IsNull(Me.FirstName) Then
MsgBox "First name must be entered", vbExclamation, "Invalid Operation"
Me.FirstName.SetFocus
ElseIf IsNull(Me.Lastname) Then
MsgBox "Last name must be entered", vbExclamation, "Invalid Operation"
Me.Lastname.SetFocus
End If
End Sub
Private Sub FirstName_BeforeUpdate(Cancel As Integer)
If IsNull(Me.FirstName) Then
MsgBox "First name must be entered", vbExclamation, "Invalid Operation"
End If
End Sub
Private Sub Form_AfterUpdate()
' reset variable to False
blnSaved = False
End Sub
Private Sub Form_BeforeUpdate(Cancel As Integer)
Dim strMessage As String
Dim strCriteria As String
' cancel update if variable is False,
' i.e. save button has not been clicked
If Not blnSaved Then
Cancel = True
Exit Sub
End If
' ensure first and last names have been entered
If IsNull(Me.FirstName) Then
MsgBox "First name must be entered", vbExclamation, "Invalid Operation"
Cancel = True
Me.FirstName.SetFocus
Exit Sub
End If
If IsNull(Me.Lastname) Then
MsgBox "Last name must be entered", vbExclamation, "Invalid Operation"
Cancel = True
Me.Lastname.SetFocus
Exit Sub
End If
' ensure names not duplicated
strCriteria = "FirstName = """ & Me.FirstName & _
""" And LastName = """ & Me.Lastname & _
""" And ContactID <> " & Me.ContactID
If Not IsNull(DLookup("ContactID", "Contacts", strCriteria)) Then
strMessage = Me.FirstName & " " & Me.Lastname & _
" already exists in database."
MsgBox strMessage, vbExclamation, "Invalid Opeartion"
Cancel = True
End If
End Sub
Private Sub Form_Current()
' reset variable to False
blnSaved = False
' disable buttons
' move focus to another control first
Me.FirstName.SetFocus
Me.cmdSave.Enabled = False
Me.cmdUndo.Enabled = False
Me.cmdClose.Enabled = True
End Sub
Private Sub Form_Dirty(Cancel As Integer)
' enable buttons
Me.cmdSave.Enabled = True
Me.cmdUndo.Enabled = True
Me.cmdClose.Enabled = False
End Sub
Private Sub Form_Error(DataErr As Integer, Response As Integer)
Const IS_DIRTY = 2169
Const MESSAGETEXT = "Record will not be saved."
' suppress system error message if form
' is closed while record is unsaved,
' NB: changes to current record will be lost
If DataErr = IS_DIRTY Then
MsgBox MESSAGETEXT, vbExclamation, "Warning"
Response = acDataErrContinue
End If
End Sub
Private Sub Form_Undo(Cancel As Integer)
' only allow record to be undone via Undo button
Cancel = Not blnAllowUndo
End Sub
Private Sub Form_Unload(Cancel As Integer)
' prevent closure if not via button
Cancel = Not blnAllowClose
End Sub
Private Sub Lastname_BeforeUpdate(Cancel As Integer)
If IsNull(Me.Lastname) Then
MsgBox "Last name must be entered", vbExclamation, "Invalid Operation"
End If
End Sub
Private Sub Lastname_GotFocus()
If IsNull(Me.FirstName) Then
MsgBox "First name must be entered", vbExclamation, "Invalid Operation"
Me.FirstName.SetFocus
End If
End Sub
Ken Sheridan, Stafford, England
