Consulting

Results 1 to 10 of 10

Thread: Duplication of Message Prompt

  1. #1

    Duplication of Message Prompt

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



    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?

  2. #2
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    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

  3. #3
    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

  4. #4
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    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.

  5. #5
    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.

  6. #6
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    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?

  7. #7
    VBAX Newbie
    Joined
    Jul 2021
    Posts
    2
    Location
    Last edited by moke123; 07-17-2021 at 03:06 AM.

  8. #8
    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

  9. #9
    VBAX Guru
    Joined
    Mar 2005
    Posts
    3,296
    Location
    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.

  10. #10
    VBAX Newbie
    Joined
    Jul 2021
    Posts
    2
    Location
    I did but tested and it still works with the colon so I deleted post

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •