Duplication of Message Prompt

I have any application with multiple tabs (see below).

Attachment 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).

Code:

---

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?

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

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

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.

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.

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?

cross post https://www.access-programmers.co.uk...-event.318741/

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:

Code:

---

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

---

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.

I did but tested and it still works with the colon so I deleted post