PDA

View Full Version : Duplication of Message Prompt


BusyBeeBiker
07-16-2021, 07:06 AM
I have any application with multiple tabs (see below).

28740

The aim is complete the Contact Tab before allowing access to the other Tabs, which I have successfully achieved using the following code embedded in the Change Event of the the Tab Control associated with this form (code below).



Private Sub TabCtPersonnel_Change()
If glbHandleErrors Then On Error GoTo ErrHandler ' Set Error Handling


Dim dbs As DAO.Database ' Dimension Database
Dim rs As DAO.Recordset ' Dimesion Recordset
Dim strSQL As String ' Dimension SQL Statement
Static Counter As Integer

Set dbs = CurrentDb ' Initialise a reference to the current database


strSQL = "SELECT tblStatus.pkStatusID, tblStatus.fkPersonID FROM tblStatus " _
& "WHERE NZ(tblStatus.fkPersonID,0) = " & Nz([Forms]![frmPersonnel]![pkPersonID], 0) & ";"

Set rs = dbs.OpenRecordset(strSQL) ' Initialise Recordset to determine if Available.


' 1. CHECKS TO SEE IF CONTACT DETAILS HAVE BEEN COMPLETED, PRIMARILY SURNAME FIELD.
If IsNull(Me.txtSurname) Then
Me.TabCtPersonnel = 0 ' Moves to Contact Tab
MsgBox "Complete Surname in Contact Tab before accessing other Tabs"
GoTo ExitHere:
End If


' 2. CHECKS TO SEE IF STATUS INFO SUB FORM HAS BEEN FILLED OUT CORRECTLY.
If rs.RecordCount = 0 Then
Me.TabCtPersonnel = 0 ' Moves to Contact Tab
MsgBox "Complete Status and Start Date fields of Status Info Sub Form to Access Other Tabs"
Me!frmStatusSubForm.Form.txtStatusDesc.SetFocus ' Returns focus to first field of Status Info Sub Form
Else
' Checks to see that BOTH Type and Start Date fields are complete.
If IsNull(Me!frmStatusSubForm.Form.txtStatusDesc) Or IsNull(Me!frmStatusSubForm.Form.dtmSStart) Then
Me.TabCtPersonnel = 0 ' Moves to Contact Tab
MsgBox "Complete Status and Start Date fields of Status Info Sub Form to Access Other Tabs"
If IsNull(Me!frmStatusSubForm.Form.txtStatusDesc) Then
Me!frmStatusSubForm.Form.txtStatusDesc.SetFocus
Else
Me!frmStatusSubForm.Form.dtmSStart.SetFocus
End If
GoTo ExitHere:
End If
End If

' 3. CHECKS TO SEE WHICH TABS USER HAS ACCESS TO DEPENDENT ON SECURITY LEVEL AND TYPE OF PERSON STAFF, LEARNER, ETC.
Select Case Me.TabCtPersonnel.Value
Case Me.pgContact.PageIndex ' Contact Tab


Case Me.pgPersonal.PageIndex ' Personal Tab


Case Me.pgLearner1.PageIndex ' Learner Tab
If Not Forms("frmPersonnel").Form("frmStatusSubForm").Form("txtStatusDesc") Like "Learner" Then
Forms!frmPersonnel.TabCtPersonnel = 0 ' Moves to Contact Tab
End If


Case Me.pgStaff.PageIndex ' Staff Tab
If Not Forms("frmPersonnel").Form("frmStatusSubForm").Form("txtStatusDesc") Like "Staff*" Then
Forms!frmPersonnel.TabCtPersonnel = 0 ' Moves to Contact Tab
End If

Case Me.pgVolunteer.PageIndex ' Volunteer Tab
If Not Forms("frmPersonnel").Form("frmStatusSubForm").Form("txtStatusDesc") Like "Volunteer" Then
Forms!frmPersonnel.TabCtPersonnel = 0 ' Moves to Contact Tab
End If

Case Me.pgHumanResource.PageIndex ' Human Resources Tab
' Only Allows Security Level of >8 AND doesn't allow Person to see own record.
If Forms!frmLoginScreen!numSecurityLevel < 8 Or Me!pkPersonID = Forms!frmLoginScreen!fkID Then
Forms!frmPersonnel.TabCtPersonnel = 0 ' Moves to Contact Tab
Else
' Only show record if Persons Login Security Level is < Person Logged in.
strSQL = "SELECT tblPerson.pkPersonID, tblLogin.fkID, tblLogin.numSecurityLevel " _
& "FROM tblPerson LEFT JOIN tblLogin ON tblPerson.pkPersonID = tblLogin.fkID " _
& "WHERE IIF(IsNull(tblLogin.numSecurityLevel),0,tblLogin.numSecurityLevel)<" & Forms!frmLoginScreen!numSecurityLevel & " " _
& "AND tblLogin.fkID=" & Forms!frmPersonnel!pkPersonID & ";"

Set rs = dbs.OpenRecordset(strSQL) ' Initialise Recordset to determine if Available.

rs.MoveFirst

' Do While Not rs.BOF And Not rs.EOF
If rs.NoMatch Then
Forms!frmPersonnel.TabCtPersonnel = 0 ' Moves to Contact Tab
End If
' Loop
End If

Case Me.pgLearner.PageIndex ' SnapShot Tab
If Not Forms("frmPersonnel").Form("frmStatusSubForm").Form("txtStatusDesc") Like "Learner" Then
Forms!frmPersonnel.TabCtPersonnel = 0 ' Moves to Contact Tab
End If

Case Me.pgAttendance.PageIndex ' Time Tab


Case Me.pgAdmin.PageIndex ' Admin Tab


End Select



ExitHere: ' Any Error Clean Up Code
rs.Close
dbs.Close
Set rs = Nothing
Set dbs = Nothing
Err.Clear
Exit Sub

ErrHandler: ' ERROR HANDLING ROUTINE.
If Err.Number <> 0 Then
Call LogError(Err.Number, Err.Description, Forms!frmLoginScreen!fkID, Environ("UserName"), Environ("ComputerName"), "", glbHandleErrors)
Resume ExitHere
End If


End Sub




Problem I have is the the MsgBox lines of code (highlighted red) appear TWICE rather than the ONCE.

Any idea what is causing this, debugging shows that it hits the MsgBox line fires, goes to ExitHere: then circles back around to the MsgBox again before returning to the Contact Tab. If you look at ExitHere: its set up to Exit Sub at the end so why is it looping?
OBP
07-16-2021, 11:41 AM
It is possibly due to the fact you are opening a new recordset, rather than using a recordsetclone of the form's data.
I can't see any reason for the exithere not to work
BusyBeeBiker
07-16-2021, 01:38 PM
I take your point and will try that, but if you look at the first validation point that has a MsgBox, how would recordsets affect that particular piece of code?

Pretty new to VBA programming the strQL variable is referring to a sub form (frmStatusSubForm) of the main form(frmPersonnel) is something along the lines:

rs = Forms!frmPersonnel.frmStatusSubForm.RecordSetClone

Many thanks
OBP
07-17-2021, 12:55 AM
I am not sure, It will also be more difficult to find the correct record with a recordset.
There is one thing that I would try, it is not as elegant as your exithere.
I would replace the code
Goto exithere

With the simpler
Exit Sub.


The other thing to try is to move the Opening of your current recordset to after the messages, so that it is only opened when required.

You could also set the Tab permissions to "Public Variables" (which is what I use) when the person logs in which are available at any time to any form and does not require opening the recordset at all.

Without having the code to run this is all guesswork unfortunately.
BusyBeeBiker
07-17-2021, 01:19 AM
Picking up on your points above:
Replacement of GoTo ExitHere to Exit Sub. Already tried that same result.
Same with opening recordset to after messages. Already tried that same result.
Can you expand on what you mean by Tab permissions to "Public Variables"?

It seems that clicking on another Tab causes the Change event to fire, but then when the user responds to the Message prompt it causes the Change Event to re-fire. However if that's the case, why doesn't it keeping on re-firing when the User responds to the prompt rather than kicking out of the Change Event the second time around? Weird.
OBP
07-17-2021, 01:42 AM
You have done a thorough job.
Access does have quite a few idiosyncrasies.
OK, I am not sure how many Tabs you need to allow for.
But to declare a Public Variable you do so in a module.
This is an example of one I use

Public lngMyEmpID As Long, mypermission As Long, myclient As Long, olddate As Date, changes As String, strname As String

Which are set in the login form's VBA

lngMyEmpID = Me.cboEmployee.Value
mypermission = Me.cboEmployee.Column(2)

The other variables are for recording what data gets changed by whom and when on what form for auditing.

So would you want to set a permission level overall or one for each tab?
moke123
07-17-2021, 02:56 AM
cross post https://www.access-programmers.co.uk/forums/threads/duplication-of-message-prompt-in-change-event.318741/
arnelgp
07-17-2021, 02:56 AM
you are changing the tab control to it's first tab, therefore the Change event fires again.
wht you need is to have a Form variable that will tell it not to process the second change event:


Option Compare DatabaseOption Explicit


Dim bolHandled As Boolean


Private Sub TabCtPersonnel_Change()


If bolHandled Then
bolHandled = False
Exit Sub
End If


If glbHandleErrors Then On Error GoTo ErrHandler ' Set Error Handling




Dim dbs As DAO.Database ' Dimension Database
Dim rs As DAO.Recordset ' Dimesion Recordset
Dim strSQL As String ' Dimension SQL Statement
Static Counter As Integer

Set dbs = CurrentDb ' Initialise a reference to the current database




strSQL = "SELECT tblStatus.pkStatusID, tblStatus.fkPersonID FROM tblStatus " _
& "WHERE NZ(tblStatus.fkPersonID,0) = " & Nz([Forms]![frmPersonnel]![pkPersonID], 0) & ";"

Set rs = dbs.OpenRecordset(strSQL) ' Initialise Recordset to determine if Available.




' 1. CHECKS TO SEE IF CONTACT DETAILS HAVE BEEN COMPLETED, PRIMARILY SURNAME FIELD.
If IsNull(Me.txtSurname) Then
bolHandled = True
MsgBox "Complete Surname in Contact Tab before accessing other Tabs"
Me.TabCtPersonnel = 0 ' Moves to Contact Tab
GoTo ExitHere:
End If




' 2. CHECKS TO SEE IF STATUS INFO SUB FORM HAS BEEN FILLED OUT CORRECTLY.
If rs.RecordCount = 0 Then
bolHandled = True
MsgBox "Complete Status and Start Date fields of Status Info Sub Form to Access Other Tabs"
Me.TabCtPersonnel = 0 ' Moves to Contact Tab
Me!frmStatusSubForm.Form.txtStatusDesc.SetFocus ' Returns focus to first field of Status Info Sub Form
Else
' Checks to see that BOTH Type and Start Date fields are complete.
If IsNull(Me!frmStatusSubForm.Form.txtStatusDesc) Or IsNull(Me!frmStatusSubForm.Form.dtmSStart) Then
bolHandled = True
MsgBox "Complete Status and Start Date fields of Status Info Sub Form to Access Other Tabs"
Me.TabCtPersonnel = 0 ' Moves to Contact Tab
If IsNull(Me!frmStatusSubForm.Form.txtStatusDesc) Then
Me!frmStatusSubForm.Form.txtStatusDesc.SetFocus
Else
Me!frmStatusSubForm.Form.dtmSStart.SetFocus
End If
GoTo ExitHere:
End If
End If

' 3. CHECKS TO SEE WHICH TABS USER HAS ACCESS TO DEPENDENT ON SECURITY LEVEL AND TYPE OF PERSON STAFF, LEARNER, ETC.
Select Case Me.TabCtPersonnel.Value
Case Me.pgContact.PageIndex ' Contact Tab




Case Me.pgPersonal.PageIndex ' Personal Tab




Case Me.pgLearner1.PageIndex ' Learner Tab
If Not Forms("frmPersonnel").Form("frmStatusSubForm").Form("txtStatusDesc") Like "Learner" Then
Forms!frmPersonnel.TabCtPersonnel = 0 ' Moves to Contact Tab
End If




Case Me.pgStaff.PageIndex ' Staff Tab
If Not Forms("frmPersonnel").Form("frmStatusSubForm").Form("txtStatusDesc") Like "Staff*" Then
Forms!frmPersonnel.TabCtPersonnel = 0 ' Moves to Contact Tab
End If

Case Me.pgVolunteer.PageIndex ' Volunteer Tab
If Not Forms("frmPersonnel").Form("frmStatusSubForm").Form("txtStatusDesc") Like "Volunteer" Then
Forms!frmPersonnel.TabCtPersonnel = 0 ' Moves to Contact Tab
End If

Case Me.pgHumanResource.PageIndex ' Human Resources Tab
' Only Allows Security Level of >8 AND doesn't allow Person to see own record.
If Forms!frmLoginScreen!numSecurityLevel < 8 Or Me!pkPersonID = Forms!frmLoginScreen!fkID Then
Forms!frmPersonnel.TabCtPersonnel = 0 ' Moves to Contact Tab
Else
' Only show record if Persons Login Security Level is < Person Logged in.
strSQL = "SELECT tblPerson.pkPersonID, tblLogin.fkID, tblLogin.numSecurityLevel " _
& "FROM tblPerson LEFT JOIN tblLogin ON tblPerson.pkPersonID = tblLogin.fkID " _
& "WHERE IIF(IsNull(tblLogin.numSecurityLevel),0,tblLogin.numSecurityLevel)<" & Forms!frmLoginScreen!numSecurityLevel & " " _
& "AND tblLogin.fkID=" & Forms!frmPersonnel!pkPersonID & ";"

Set rs = dbs.OpenRecordset(strSQL) ' Initialise Recordset to determine if Available.

rs.MoveFirst

' Do While Not rs.BOF And Not rs.EOF
If rs.NoMatch Then
Forms!frmPersonnel.TabCtPersonnel = 0 ' Moves to Contact Tab
End If
' Loop
End If

Case Me.pgLearner.PageIndex ' SnapShot Tab
If Not Forms("frmPersonnel").Form("frmStatusSubForm").Form("txtStatusDesc") Like "Learner" Then
Forms!frmPersonnel.TabCtPersonnel = 0 ' Moves to Contact Tab
End If

Case Me.pgAttendance.PageIndex ' Time Tab




Case Me.pgAdmin.PageIndex ' Admin Tab




End Select





ExitHere: ' Any Error Clean Up Code
rs.Close
dbs.Close
Set rs = Nothing
Set dbs = Nothing
Err.Clear
Exit Sub

ErrHandler: ' ERROR HANDLING ROUTINE.
If Err.Number <> 0 Then
Call LogError(Err.Number, Err.Description, Forms!frmLoginScreen!fkID, Environ("UserName"), Environ("ComputerName"), "", glbHandleErrors)
Resume ExitHere
End If




End Sub
OBP
07-17-2021, 03:15 AM
The person who mentioned that the code
Goto exithere:
should not have the colon is correct.
I missed it, getting too old for this lark.
moke123
07-17-2021, 03:22 AM
I did but tested and it still works with the colon so I deleted post