Access Form Validation

L

ll

Hi,
I have an Access form and am using validation in it, to be sure that
certain boxes are completed. Is there a way to have the close button
I've created not close the form until those fields are completed?
Currently, once that button is clicked, a validation message pops up
for one of the fields, and when the user clicks 'OK' the error msg
disappears and the form closes. How can I keep the form open in that
situation? Thanks - Louis
Here's the code:

Private Sub exit_2_Click()
On Error GoTo Err_exit_2_Click

Dim intAnswer As Integer

Const strMSG = "Do you wish to exit to the menu?"

intAnswer = MsgBox(strMSG, vbInformation + vbYesNo)

Select Case intAnswer
Case vbYes
DoCmd.RunCommand acCmdSave
'DoCmd.Quit
DoCmd.Close

'Go back to switchboard
stDocName = "Switchboard"
DoCmd.OpenForm stDocName, , , stLinkCriteria


Case vbNo
Me.Undo
'Case vbCancel
' Don't do anything
End Select

Exit_exit_2_Click:
Exit Sub

Err_exit_2_Click:
MsgBox Err.Description
Resume Exit_exit_2_Click

End Sub





Private Sub Form_BeforeUpdate(Cancel As Integer)

On Error GoTo Err_cmdMainScreen_Click
Dim stDocName As String
Dim stLinkCriteria As String

'populate employee name with previous
'******** Code Start **********
'Const cQuote = """" 'Thats two quotes
'Me!cboEmplName.DefaultValue = cQuote & Me!cboEmplName.Value &
cQuote
'******** Code End **********

If IsNull(Me.cboEmplName) Then
MsgBox "Please enter the Employee Name"
Me.cboEmplName.SetFocus
Cancel = True
Exit Sub
ElseIf IsNull(Me.txtprojectName) Then
MsgBox "Please enter the Project Name"
Me.txtprojectName.SetFocus
Cancel = True
Exit Sub
ElseIf IsNull(Me.cboProjectStatus) Then
MsgBox "Please enter the Project Status"
Me.cboProjectStatus.SetFocus
Cancel = True
Exit Sub
ElseIf IsNull(Me.cboSolicStatusAbbrev) Then
MsgBox "Please enter the Solicitation Status"
Me.cboSolicStatusAbbrev.SetFocus
Cancel = True
Exit Sub
ElseIf IsNull(Me.cboSolicCampus) Then
MsgBox "Please enter the Solicitation Campus"
Me.cboSolicCampus.SetFocus
Cancel = True
Exit Sub
ElseIf IsNull(Me.cboCompletionDate) Then
MsgBox "Please enter the Project Completion Date"
Me.cboCompletionDate.SetFocus
Cancel = True
Exit Sub
ElseIf IsNull(Me.cboBuyerProjectDueDate) Then
MsgBox "Please enter the Solicitation Close Date"
Me.cboBuyerProjectDueDate.SetFocus
Cancel = True
Exit Sub
End If

Exit_cmdMainScreen_Click:
Exit Sub

Err_cmdMainScreen_Click:
Resume Exit_cmdMainScreen_Click

End Sub



'Search script (below) for project number
'--------------------------------------------------------------
'Graham Thorpe 25-01-02
'--------------------------------------------------------------
Private Sub cmdSearchA_Click()
Dim strProjID As String
Dim strSearch As String

'///
Dim rst As Object
Set rst = Me.RecordsetClone
'///

'Check txtSearch for Null value or Nill Entry first.

If IsNull(Me![txtSearch]) Or (Me![txtSearch]) = "" Then
MsgBox "Please enter a value!", vbOKOnly, "Invalid Search
Criterion!"
Me![txtSearch].SetFocus
Exit Sub
End If
If (Me![txtSearch]) = "0" Then
MsgBox "Please enter a value greater than 0.", vbOKOnly,
"Invalid Search Criterion!"
Me![txtSearch].SetFocus
Exit Sub
End If


'---------------------------------------------------------------

'Performs the search using value entered into txtSearch
'and evaluates this against values in strStudentID

DoCmd.ShowAllRecords
DoCmd.GoToControl ("txtProjID")
DoCmd.FindRecord Me!txtSearch

txtProjID.SetFocus
strProjID = txtProjID.Text
txtSearch.SetFocus
strSearch = txtSearch.Text


'//reveal form controls below once search is clicked :)
Me.Label32.Visible = True
Me.cboEmplName.Visible = True
Me.Text50.Visible = True
Me.Label55.Visible = True
Me.txtProjID.Visible = True
Me.txtprojectName.Visible = True
Me.Text52.Visible = True
Me.cboProjectStatus.Visible = True
Me.Label43.Visible = True
Me.cboProjectImportance.Visible = True
Me.cboSolicStatusAbbrev.Visible = True
Me.cboBuyerProjectDueDate.Visible = True
Me.Label38.Visible = True
Me.cboSolicCampus.Visible = True
Me.cboSolicRegentsApproval.Visible = True
Me.cboBuyerRegentDueDate.Visible = True
Me.cboCompletionDate.Visible = True
Me.All_Items.Visible = True
Me.cmdUndoChanges.Visible = True
Me.exit_2.Visible = True
Me.Text59.Visible = True

'\\\\
If IsNull(Me.Text50) Then
Me.Text50 = Date
End If

'If matching record found sets focus in strStudentID and shows msgbox
'and clears search control

If strProjID = strSearch Then
MsgBox "Match Found For: " & strSearch, , "Congratulations!"
txtProjID.SetFocus
txtSearch = ""
'If value not found sets focus back to txtSearch and shows msgbox
Else
MsgBox "Match Not Found For: " & strSearch & " - Please
Try Again.", _
, "Invalid Search Criterion!"
txtSearch.SetFocus
End If
'/////

End Sub




Private Sub Form_Current()
Me!cmdUndoChanges.Enabled = False
Dim rst As Object
Set rst = Me.RecordsetClone
Me.Text62.Value = rst.RecordCount
End Sub



Private Sub Form_Dirty(Cancel As Integer)
Me!cmdUndoChanges.Enabled = True
End Sub


Private Sub cmdUndoChanges_Click()
On Error GoTo Err_undoChanges_Click
DoCmd.RunCommand acCmdUndo

Exit_undoChanges_Click:
Exit Sub

Err_undoChanges_Click:
MsgBox Err.Description
Resume Exit_undoChanges_Click
End Sub
 
P

Pat Hartman \(MVP\)

A couple of things need to be changed:
1 "acCmdSave" saves the current OBJECT. To save the current record use
"acCmdSaveRecord"
2. Please indent your code properly as it makes it easier to read.
3. I deleted code that was commented out. It should not be left in since it
interrupts the program flow and is distracting. I also added an If
statement which should keep the form from closing as long as errors were
found and the update was cancelled. This won't stop them from clicking on
the close button though. You might want to run this code from there:
Call exit_2_Click()



Private Sub exit_2_Click()
On Error GoTo Err_exit_2_Click
Dim intAnswer As Integer
Const strMSG = "Do you wish to exit to the menu?"
intAnswer = MsgBox(strMSG, vbInformation + vbYesNo)

Select Case intAnswer
Case vbYes
DoCmd.RunCommand acCmdSaveRecord
<---------------------------------------------------
If Me.Dirty Then
<------------------------------------------------------------------------
MsgBox "Close was cancelled due to errors",vbOKOnly
<------------------------------
Exit Sub
<-----------------------------------------------------------------------------
Else
<-------------------------------------------------------------------------
DoCmd.Close
' Go back to switchboard
stDocName = "Switchboard"
DoCmd.OpenForm stDocName, , , stLinkCriteria
End If
<---------------------------------------------------------------------------------
Case Else
<-----------------------------------------------------------------------------
Me.Undo
End Select

Exit_exit_2_Click:
Exit Sub

Err_exit_2_Click:
MsgBox Err.Description
Resume Exit_exit_2_Click

End Sub

ll said:
Hi,
I have an Access form and am using validation in it, to be sure that
certain boxes are completed. Is there a way to have the close button
I've created not close the form until those fields are completed?
Currently, once that button is clicked, a validation message pops up
for one of the fields, and when the user clicks 'OK' the error msg
disappears and the form closes. How can I keep the form open in that
situation? Thanks - Louis
Here's the code:

Private Sub exit_2_Click()
On Error GoTo Err_exit_2_Click

Dim intAnswer As Integer

Const strMSG = "Do you wish to exit to the menu?"

intAnswer = MsgBox(strMSG, vbInformation + vbYesNo)

Select Case intAnswer
Case vbYes
DoCmd.RunCommand acCmdSave
'DoCmd.Quit
DoCmd.Close

'Go back to switchboard
stDocName = "Switchboard"
DoCmd.OpenForm stDocName, , , stLinkCriteria


Case vbNo
Me.Undo
'Case vbCancel
' Don't do anything
End Select

Exit_exit_2_Click:
Exit Sub

Err_exit_2_Click:
MsgBox Err.Description
Resume Exit_exit_2_Click

End Sub





Private Sub Form_BeforeUpdate(Cancel As Integer)

On Error GoTo Err_cmdMainScreen_Click
Dim stDocName As String
Dim stLinkCriteria As String

'populate employee name with previous
'******** Code Start **********
'Const cQuote = """" 'Thats two quotes
'Me!cboEmplName.DefaultValue = cQuote & Me!cboEmplName.Value &
cQuote
'******** Code End **********

If IsNull(Me.cboEmplName) Then
MsgBox "Please enter the Employee Name"
Me.cboEmplName.SetFocus
Cancel = True
Exit Sub
ElseIf IsNull(Me.txtprojectName) Then
MsgBox "Please enter the Project Name"
Me.txtprojectName.SetFocus
Cancel = True
Exit Sub
ElseIf IsNull(Me.cboProjectStatus) Then
MsgBox "Please enter the Project Status"
Me.cboProjectStatus.SetFocus
Cancel = True
Exit Sub
ElseIf IsNull(Me.cboSolicStatusAbbrev) Then
MsgBox "Please enter the Solicitation Status"
Me.cboSolicStatusAbbrev.SetFocus
Cancel = True
Exit Sub
ElseIf IsNull(Me.cboSolicCampus) Then
MsgBox "Please enter the Solicitation Campus"
Me.cboSolicCampus.SetFocus
Cancel = True
Exit Sub
ElseIf IsNull(Me.cboCompletionDate) Then
MsgBox "Please enter the Project Completion Date"
Me.cboCompletionDate.SetFocus
Cancel = True
Exit Sub
ElseIf IsNull(Me.cboBuyerProjectDueDate) Then
MsgBox "Please enter the Solicitation Close Date"
Me.cboBuyerProjectDueDate.SetFocus
Cancel = True
Exit Sub
End If

Exit_cmdMainScreen_Click:
Exit Sub

Err_cmdMainScreen_Click:
Resume Exit_cmdMainScreen_Click

End Sub



'Search script (below) for project number
'--------------------------------------------------------------
'Graham Thorpe 25-01-02
'--------------------------------------------------------------
Private Sub cmdSearchA_Click()
Dim strProjID As String
Dim strSearch As String

'///
Dim rst As Object
Set rst = Me.RecordsetClone
'///

'Check txtSearch for Null value or Nill Entry first.

If IsNull(Me![txtSearch]) Or (Me![txtSearch]) = "" Then
MsgBox "Please enter a value!", vbOKOnly, "Invalid Search
Criterion!"
Me![txtSearch].SetFocus
Exit Sub
End If
If (Me![txtSearch]) = "0" Then
MsgBox "Please enter a value greater than 0.", vbOKOnly,
"Invalid Search Criterion!"
Me![txtSearch].SetFocus
Exit Sub
End If


'---------------------------------------------------------------

'Performs the search using value entered into txtSearch
'and evaluates this against values in strStudentID

DoCmd.ShowAllRecords
DoCmd.GoToControl ("txtProjID")
DoCmd.FindRecord Me!txtSearch

txtProjID.SetFocus
strProjID = txtProjID.Text
txtSearch.SetFocus
strSearch = txtSearch.Text


'//reveal form controls below once search is clicked :)
Me.Label32.Visible = True
Me.cboEmplName.Visible = True
Me.Text50.Visible = True
Me.Label55.Visible = True
Me.txtProjID.Visible = True
Me.txtprojectName.Visible = True
Me.Text52.Visible = True
Me.cboProjectStatus.Visible = True
Me.Label43.Visible = True
Me.cboProjectImportance.Visible = True
Me.cboSolicStatusAbbrev.Visible = True
Me.cboBuyerProjectDueDate.Visible = True
Me.Label38.Visible = True
Me.cboSolicCampus.Visible = True
Me.cboSolicRegentsApproval.Visible = True
Me.cboBuyerRegentDueDate.Visible = True
Me.cboCompletionDate.Visible = True
Me.All_Items.Visible = True
Me.cmdUndoChanges.Visible = True
Me.exit_2.Visible = True
Me.Text59.Visible = True

'\\\\
If IsNull(Me.Text50) Then
Me.Text50 = Date
End If

'If matching record found sets focus in strStudentID and shows msgbox
'and clears search control

If strProjID = strSearch Then
MsgBox "Match Found For: " & strSearch, , "Congratulations!"
txtProjID.SetFocus
txtSearch = ""
'If value not found sets focus back to txtSearch and shows msgbox
Else
MsgBox "Match Not Found For: " & strSearch & " - Please
Try Again.", _
, "Invalid Search Criterion!"
txtSearch.SetFocus
End If
'/////

End Sub




Private Sub Form_Current()
Me!cmdUndoChanges.Enabled = False
Dim rst As Object
Set rst = Me.RecordsetClone
Me.Text62.Value = rst.RecordCount
End Sub



Private Sub Form_Dirty(Cancel As Integer)
Me!cmdUndoChanges.Enabled = True
End Sub


Private Sub cmdUndoChanges_Click()
On Error GoTo Err_undoChanges_Click
DoCmd.RunCommand acCmdUndo

Exit_undoChanges_Click:
Exit Sub

Err_undoChanges_Click:
MsgBox Err.Description
Resume Exit_undoChanges_Click
End Sub
Click to expand...
 
L

ll

Pat,
Thanks very much for your help with this - it works wonderfully.
Thanks also for the tips in coding. I'm relatively new and this, and
every pointer helps. :)

-Louis




A couple of things need to be changed:
1 "acCmdSave" saves the current OBJECT. To save the current record use
"acCmdSaveRecord"
2. Please indent your code properly as it makes it easier to read.
3. I deleted code that was commented out. It should not be left in since it
interrupts the program flow and is distracting. I also added an If
statement which should keep the form from closing as long as errors were
found and the update was cancelled. This won't stop them from clicking on
the close button though. You might want to run this code from there:
Call exit_2_Click()

Private Sub exit_2_Click()
On Error GoTo Err_exit_2_Click
Dim intAnswer As Integer
Const strMSG = "Do you wish to exit to the menu?"
intAnswer = MsgBox(strMSG, vbInformation + vbYesNo)

Select Case intAnswer
Case vbYes
DoCmd.RunCommand acCmdSaveRecord
<---------------------------------------------------
If Me.Dirty Then
<------------------------------------------------------------------------
MsgBox "Close was cancelled due to errors",vbOKOnly
<------------------------------
Exit Sub
<-----------------------------------------------------------------------------
Else
<-------------------------------------------------------------------------
DoCmd.Close
' Go back to switchboard
stDocName = "Switchboard"
DoCmd.OpenForm stDocName, , , stLinkCriteria
End If
<---------------------------------------------------------------------------------
Case Else
<-----------------------------------------------------------------------------
Me.Undo
End Select

Exit_exit_2_Click:
Exit Sub

Err_exit_2_Click:
MsgBox Err.Description
Resume Exit_exit_2_Click

End Sub


Hi,
I have an Access form and am using validation in it, to be sure that
certain boxes are completed. Is there a way to have the close button
I've created not close the form until those fields are completed?
Currently, once that button is clicked, a validation message pops up
for one of the fields, and when the user clicks 'OK' the error msg
disappears and the form closes. How can I keep the form open in that
situation? Thanks - Louis
Here's the code:
Click to expand...
Private Sub exit_2_Click()
On Error GoTo Err_exit_2_Click
Click to expand...
Dim intAnswer As Integer
Click to expand...
Const strMSG = "Do you wish to exit to the menu?"
Click to expand...
intAnswer = MsgBox(strMSG, vbInformation + vbYesNo)
Click to expand...
Select Case intAnswer
Case vbYes
DoCmd.RunCommand acCmdSave
'DoCmd.Quit
DoCmd.Close
Click to expand...
'Go back to switchboard
stDocName = "Switchboard"
DoCmd.OpenForm stDocName, , , stLinkCriteria
Click to expand...
Case vbNo
Me.Undo
'Case vbCancel
' Don't do anything
End Select
Click to expand...
Exit_exit_2_Click:
Exit Sub
Click to expand...
Err_exit_2_Click:
MsgBox Err.Description
Resume Exit_exit_2_Click
Click to expand...
End Sub
Click to expand...
Private Sub Form_BeforeUpdate(Cancel As Integer)
Click to expand...
On Error GoTo Err_cmdMainScreen_Click
Dim stDocName As String
Dim stLinkCriteria As String
Click to expand...
'populate employee name with previous
'******** Code Start **********
'Const cQuote = """" 'Thats two quotes
'Me!cboEmplName.DefaultValue = cQuote & Me!cboEmplName.Value &
cQuote
'******** Code End **********
Click to expand...
If IsNull(Me.cboEmplName) Then
MsgBox "Please enter the Employee Name"
Me.cboEmplName.SetFocus
Cancel = True
Exit Sub
ElseIf IsNull(Me.txtprojectName) Then
MsgBox "Please enter the Project Name"
Me.txtprojectName.SetFocus
Cancel = True
Exit Sub
ElseIf IsNull(Me.cboProjectStatus) Then
MsgBox "Please enter the Project Status"
Me.cboProjectStatus.SetFocus
Cancel = True
Exit Sub
ElseIf IsNull(Me.cboSolicStatusAbbrev) Then
MsgBox "Please enter the Solicitation Status"
Me.cboSolicStatusAbbrev.SetFocus
Cancel = True
Exit Sub
ElseIf IsNull(Me.cboSolicCampus) Then
MsgBox "Please enter the Solicitation Campus"
Me.cboSolicCampus.SetFocus
Cancel = True
Exit Sub
ElseIf IsNull(Me.cboCompletionDate) Then
MsgBox "Please enter the Project Completion Date"
Me.cboCompletionDate.SetFocus
Cancel = True
Exit Sub
ElseIf IsNull(Me.cboBuyerProjectDueDate) Then
MsgBox "Please enter the Solicitation Close Date"
Me.cboBuyerProjectDueDate.SetFocus
Cancel = True
Exit Sub
End If
Click to expand...
Exit_cmdMainScreen_Click:
Exit Sub
Click to expand...
Err_cmdMainScreen_Click:
Resume Exit_cmdMainScreen_Click
Click to expand...
End Sub
Click to expand...
'Search script (below) for project number
'--------------------------------------------------------------
'Graham Thorpe 25-01-02
'--------------------------------------------------------------
Private Sub cmdSearchA_Click()
Dim strProjID As String
Dim strSearch As String
Click to expand...
'///
Dim rst As Object
Set rst = Me.RecordsetClone
'///
Click to expand...
'Check txtSearch for Null value or Nill Entry first.
Click to expand...
If IsNull(Me![txtSearch]) Or (Me![txtSearch]) = "" Then
MsgBox "Please enter a value!", vbOKOnly, "Invalid Search
Criterion!"
Me![txtSearch].SetFocus
Exit Sub
End If
If (Me![txtSearch]) = "0" Then
MsgBox "Please enter a value greater than 0.", vbOKOnly,
"Invalid Search Criterion!"
Me![txtSearch].SetFocus
Exit Sub
End If
'---------------------------------------------------------------
Click to expand...

'Performs the search using value entered into txtSearch
'and evaluates this against values in strStudentID
Click to expand...
DoCmd.ShowAllRecords
DoCmd.GoToControl ("txtProjID")
DoCmd.FindRecord Me!txtSearch
Click to expand...
txtProjID.SetFocus
strProjID = txtProjID.Text
txtSearch.SetFocus
strSearch = txtSearch.Text
Click to expand...
'//reveal form controls below once search is clicked :)
Me.Label32.Visible = True
Me.cboEmplName.Visible = True
Me.Text50.Visible = True
Me.Label55.Visible = True
Me.txtProjID.Visible = True
Me.txtprojectName.Visible = True
Me.Text52.Visible = True
Me.cboProjectStatus.Visible = True
Me.Label43.Visible = True
Me.cboProjectImportance.Visible = True
Me.cboSolicStatusAbbrev.Visible = True
Me.cboBuyerProjectDueDate.Visible = True
Me.Label38.Visible = True
Me.cboSolicCampus.Visible = True
Me.cboSolicRegentsApproval.Visible = True
Me.cboBuyerRegentDueDate.Visible = True
Me.cboCompletionDate.Visible = True
Me.All_Items.Visible = True
Me.cmdUndoChanges.Visible = True
Me.exit_2.Visible = True
Me.Text59.Visible = True
Click to expand...
'\\\\
If IsNull(Me.Text50) Then
Me.Text50 = Date
End If
Click to expand...
'If matching record found sets focus in strStudentID and shows msgbox
'and clears search control
Click to expand...
If strProjID = strSearch Then
MsgBox "Match Found For: " & strSearch, , "Congratulations!"
txtProjID.SetFocus
txtSearch = ""
'If value not found sets focus back to txtSearch and shows msgbox
Else
MsgBox "Match Not Found For: " & strSearch & " - Please
Try Again.", _
, "Invalid Search Criterion!"
txtSearch.SetFocus
End If
'/////
Click to expand...
End Sub
Click to expand...
Private Sub Form_Current()
Me!cmdUndoChanges.Enabled = False
Dim rst As Object
Set rst = Me.RecordsetClone
Me.Text62.Value = rst.RecordCount
End Sub
Click to expand...
Private Sub Form_Dirty(Cancel As Integer)
Me!cmdUndoChanges.Enabled = True
End Sub
Click to expand...
Private Sub cmdUndoChanges_Click()
On Error GoTo Err_undoChanges_Click
DoCmd.RunCommand acCmdUndo
Click to expand...
Exit_undoChanges_Click:
Exit Sub
Click to expand...
Err_undoChanges_Click:
MsgBox Err.Description
Resume Exit_undoChanges_Click
End Sub
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

DoCmd.GoToControl "[MODEL]" 1
Record Search within a Form 3
Invalid Qualifier 0
VB Coding Assistance 2
no current record 1
Main Form / Sub Form Search 2
Run-time error 3061; Too few parameters. Expected 2 3
Excel Providing user message when RED X clicked & properly closing application. 2

Top