Page 1 of 2 12 LastLast
Results 1 to 15 of 17
  1. #1
    ocm is offline Advanced Beginner
    Windows 7 32bit Access 2010 32bit
    Join Date
    Mar 2013
    Posts
    39

    Drop down not showing all values

    Greetings,



    We’re currently running access 2016 split database (with individual front-end and shared back-end)

    Couple of questions:

    1. We have a form with a drop-down whereby users select either P: Providers or C: Clients to populate the name of the provider or the client. However, the list that is populated is not complete (e.g. provider name that starts with the letter (P-Z) did not show in the list. I checked the tables to verify the provider names are up to date.

    a. I checked properties > data tab > Record Source is blank
    B. In design mode I also checked properties of the object’s name it shows cboType

    2. Though we have a login form where users enter their credentials to log in, we noticed just clicking login will let users access to the application (without entering username & password)


    TIA

    Regards,

  2. #2
    orange's Avatar
    orange is online now Moderator
    Windows 10 Access 2010 32bit
    Join Date
    Sep 2009
    Location
    Ottawa, Ontario, Canada; West Palm Beach FL
    Posts
    16,716

  3. #3
    Bulzie is offline VIP
    Windows 7 64bit Access 2007
    Join Date
    Nov 2015
    Posts
    1,463
    1. How many records does the list have? I think there is a limit on number of records that will display in list or combo box.
    2. What code is behind the Login button? Make sure it is there and did not get erased. If code is there post it here or put a breakpoint in it and step through the code.

  4. #4
    aytee111 is offline Competent At Times
    Windows 10 Access 2013 64bit
    Join Date
    Nov 2011
    Location
    Nomad
    Posts
    3,936
    There is a limit to the number of entries a combo will display, you may have reached that limit. You may have to have a text box with an AfterUpdate routine that sets a filter instead.

  5. #5
    ocm is offline Advanced Beginner
    Windows 7 32bit Access 2010 32bit
    Join Date
    Mar 2013
    Posts
    39
    Thanks both for the reply post.

    re: How many records does the list have?
    --> looking at the table there are over 72000 records

    re: What code is behind the Login button?
    --> on click event

    Code:
    Option Compare Database
    Public gblUserNm As String
    Private Sub cmdClose_Click()
    'Close The Login and Close Database Once Cancel is Clicked
    On Error GoTo err_cmdClose_Click
     
    DoCmd.Quit
     
    Exit_cmdClose_Click:
        Exit Sub
       
    err_cmdClose_Click:
        MsgBox Err.Description
        Resume Exit_cmdClose_Click
       
    End Sub
     
    Private Sub cmdLOGIN_Click()
    'Enable certain options on the main menu screen depending on access level
        'If Me.txtPWD Like "SU*" Then
        '    Forms!frmMainMenu!optMaintenance.Enabled = False
        'Else
        '    If Me.txtPWD Like "US*" Then
        '        Forms!frmMainMenu!optReports.Enabled = False
        '        Forms!frmMainMenu!optSuspCase.Enabled = False
        '        Forms!frmMainMenu!optMaintenance.Enabled = False
        '    End If
        'End If
        DoCmd.OpenForm "frmMainMenu"
        Me.Visible = False
       
    End Sub
     
    Private Sub Form_Open(Cancel As Integer)
    'Once Form Is Open Enable Everything and Set Focus To User Name Field
        Application.SetOption "Confirm Action Queries", False
        Me.txtAttempts = 0
        Me.txtUserNm.SetFocus
    End Sub
     
    Private Sub txtPWD_AfterUpdate()
    'Password validation
    Dim db As DAO.Database
    Dim rstUser As DAO.Recordset
    Dim strUserNm As String
    Dim intNum As Integer
     
    'Set db = CurrentDb     'set db to PICTS DB
    Set db = OpenDatabase("S:\OIG PICTS DB\ADMIN\PICTS DB_be")
    Set rstUser = db.OpenRecordset("tblLOGIN")
    strUserNm = txtUserNm
    rstUser.Index = "USERNM"
    rstUser.Seek "=", strUserNm
     
    If rstUser!EncryptPWD = Me.txtPWD Then
        'Enable certain options on the main menu screen depending on access levels
        If Me.txtPWD = "SU900Sus" Then
            DoCmd.OpenForm "frmMainMenu"
            Forms!frmMainMenu!optMaintenance.Enabled = False
            Forms!frmMainMenu!optMCO.Enabled = True
            'DoCmd.Close acForm, "frmLogin"
        Else
            If Me.txtPWD Like "su503Eri" Then
                DoCmd.OpenForm "frmMainMenu"
                Forms!frmMainMenu!optMCO.Enabled = False
                Forms!frmMainMenu!optComplaint.Enabled = True
                Forms!frmMainMenu!optSuspCase.Enabled = False
                Forms!frmMainMenu!optMaintenance.Enabled = False
            Else
                If Me.txtPWD Like "SU*" Then
                    DoCmd.OpenForm "frmMainMenu"
                    Forms!frmMainMenu!optReports.Enabled = True
                    Forms!frmMainMenu!optMaintenance.Enabled = False
                    Forms!frmMainMenu!optMCO.Enabled = False
                    Forms!frmMainMenu!optComplaint.Enabled = False
                Else
                    If Me.txtPWD Like "us502Mic" Then
                        DoCmd.OpenForm "frmMainMenu"
                        Forms!frmMainMenu!optReports.Enabled = False
                        Forms!frmMainMenu!optComplaint.Enabled = True
                        Forms!frmMainMenu!optSuspCase.Enabled = False
                        Forms!frmMainMenu!optMaintenance.Enabled = False
                        Forms!frmMainMenu!optMCO.Enabled = False
                    Else
                        If Me.txtPWD Like "us501Tan" Then
                            DoCmd.OpenForm "frmMainMenu"
                            Forms!frmMainMenu!optReports.Enabled = False
                            Forms!frmMainMenu!optComplaint.Enabled = True
                            Forms!frmMainMenu!optSuspCase.Enabled = False
                            Forms!frmMainMenu!optMaintenance.Enabled = False
                            Forms!frmMainMenu!optMCO.Enabled = True
                         Else
                            If Me.txtPWD Like "us601Sur" Then
                                DoCmd.OpenForm "frmMainMenu"
                                Forms!frmMainMenu!optReports.Enabled = False
                                Forms!frmMainMenu!optComplaint.Enabled = True
                                Forms!frmMainMenu!optSuspCase.Enabled = False
                                Forms!frmMainMenu!optMaintenance.Enabled = False
                                Forms!frmMainMenu!optMCO.Enabled = False
                                'DoCmd.Close acForm, "frmLogin"
                            Else
                                If Me.txtPWD Like "US*" Then
                                    DoCmd.OpenForm "frmMainMenu"
                                    Forms!frmMainMenu!optReports.Enabled = False
                                    Forms!frmMainMenu!optComplaint.Enabled = False
                                    Forms!frmMainMenu!optMaintenance.Enabled = False
                                    Forms!frmMainMenu!optMCO.Enabled = False
                                Else
                                    If Me.txtPWD Like "AD*" Then
                                        DoCmd.OpenForm "frmMainMenu"
                                        'DoCmd.Close acForm, "frmLogin"
                                    Else
                                        If Me.txtPWD = "oig901ml" Then
                                            DoCmd.OpenForm "frmMainMenu"
                                            Forms!frmMainMenu!optMaintenance.Enabled = False
                                        End If
                                    End If
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        End If
    Else
        MsgBox "Password Is Invalid - Try Again!", vbCritical + vbOKOnly, "INVALID PASSWORD"
        Me.txtInvalidPW = "Y"
        Me.txtAttempts = Me.txtAttempts + 1
        If Me.txtAttempts = 3 Then
            MsgBox "Check Password And Try Again" & vbCrLf & "       GOOD-BYE", vbCritical + vbOKOnly, "TRY AGAIN LATER"
            DoCmd.Quit
          
        Else
             Me.txtPWD.SetFocus
             Me.cmdLOGIN.Enabled = False
        End If
    End If
     
    End Sub
    Private Sub txtUserNm_AfterUpdate()
    'User validation
    Dim db As DAO.Database
    Dim rstUser As DAO.Recordset
    Dim strUserNm As String
     
    'Set db = CurrentDb     'set db to PICTS DB
    Set db = OpenDatabase("S:\OIG PICTS DB\ADMIN\PICTS DB_be")
    Set rstUser = db.OpenRecordset("tblLOGIN")
    strUserNm = Me.txtUserNm
    gblUserNm = Me.txtUserNm
    rstUser.Index = "USERNM"
    rstUser.Seek "=", strUserNm
    If rstUser.NoMatch = False Then
        Me.txtPWD.Enabled = True
        Me.txtPWD.SetFocus
        Me.txtValidUser = "Y"
    Else
        MsgBox "No Match For User Name " & strUserNm, vbInformation + vbOKOnly, "INVALID USER NAME"
        Me.txtAttempts = Me.txtAttempts + 1
        If Me.txtAttempts = 3 Then
            MsgBox "Check User Name And Try Again" & vbCrLf & "          GOOD-BYE", vbCritical + vbOKOnly, "TRY AGAIN LATER"
            DoCmd.Close
        Else
            Me.txtUserNm = Null
            Me.txtUserNm.SetFocus
        End If
    End If
     
    End Sub
     
    Private Sub txtUserNm_BeforeUpdate(Cancel As Integer)
    'Check To See If User Are Valid. Look Into The Table To Get User Status
    Dim strUser As String
    Dim strStatus As String
    Dim strSQL As String
    Dim db As DAO.Database
    Dim rstStatus As DAO.Recordset
     
    Set db = OpenDatabase("S:\OIG PICTS DB\ADMIN\PICTS DB_be")
    Set rstStatus = db.OpenRecordset("tblLOGIN")
    strUser = Me.txtUserNm
    rstStatus.Index = "USERNM"
    rstStatus.Seek "=", strUser
     
    If rstStatus!STATUS = "A" Then
        strStatus = rstStatus!STATUS
        Me.txtStatus = strStatus
    End If
     
        If Me.txtStatus = "A" Then
            Me.txtPWD.Enabled = True
    '        Me.txtPWD.SetFocus
            Me.txtValidUser = "Y"
        Else
            MsgBox "Invalid User Name Try Again" & vbCrLf & "          GOOD-BYE", vbCritical + vbOKOnly, "TRY AGAIN LATER"
            Me.txtValidUser = "N"
            Me.txtPWD.Enabled = False
            Me.cmdLOGIN.Enabled = False
            DoCmd.Quit
        End If
    End Sub
     
    Private Sub txtUserNm_GotFocus()
    'Check Users Information If Valid Then Set Focus To Password Otherwise Close
        If Me.txtValidUser = "Y" And Me.txtInvalidPW = "Y" Then
            Me.txtPWD.SetFocus
        End If
       
    End Sub

  6. #6
    ocm is offline Advanced Beginner
    Windows 7 32bit Access 2010 32bit
    Join Date
    Mar 2013
    Posts
    39
    aytee111,

    How do I go about creating a text box with an AfterUpdate routine? The database was design by someone else and following is what they had for Afterupdate:

    Code:
    Option Compare Database
     
    Private Sub cboCasTyp_AfterUpdate()
    'Assigning The Case Type To The Case Type In The Main Form
        If IsNull(Me.cboCasTyp) = False Then
            Forms!frmPICTSMain!txtCaseType = Me.cboCasTyp
            Cancel = True
        End If
       
        'Close Dialog box
        DoCmd.Close acForm, "frmGetCaseType"
               
    End Sub
     
    Private Sub cboCasTyp_BeforeUpdate(Cancel As Integer)
    'Check To See IF Field Is Null If So Sends a Message To Users
        If IsNull(Me.cboCasTyp) = True Then
            MsgBox "Must Select A Case Type", vbCritical + vbOKOnly, "SELECT CASE TYPE"
            Cancel = True
        End If
           
    End Sub
    Private Sub cboCasTyp_GotFocus()
    'Drop Down Case Type Options
        Me.cboCasTyp.Dropdown
       
    End Sub
     
    Private Sub Form_Open(Cancel As Integer)
    'On Open Set Focus To Case Type
        Me.cboCasTyp.SetFocus
           
    End Sub

  7. #7
    Bulzie is offline VIP
    Windows 7 64bit Access 2007
    Join Date
    Nov 2015
    Posts
    1,463
    Looks like your login code was commented out so clicking button goes directly to opening frmMainMenu. If you need that code, take out that apostrophe at beginning of each line of code (leave it for that line that starts 'Enable certain...).

    Private Sub cmdLOGIN_Click()
    'Enable certain options on the main menu screen depending on access level
    'If Me.txtPWD Like "SU*" Then
    ' Forms!frmMainMenu!optMaintenance.Enabled = False
    'Else
    ' If Me.txtPWD Like "US*" Then
    ' Forms!frmMainMenu!optReports.Enabled = False
    ' Forms!frmMainMenu!optSuspCase.Enabled = False
    ' Forms!frmMainMenu!optMaintenance.Enabled = False
    ' End If
    'End If
    DoCmd.OpenForm "frmMainMenu"
    Me.Visible = False

    End Sub

  8. #8
    aytee111 is offline Competent At Times
    Windows 10 Access 2013 64bit
    Join Date
    Nov 2011
    Location
    Nomad
    Posts
    3,936
    All you need to do is put the value on to the main form. With this code the user could close the form and leave the field blank, you will need to check for that in the main form (if it doesn't already).

    Code:
    Private Sub txtCasTyp_AfterUpdate()
    'Assigning The Case Type To The Case Type In The Main Form
        If IsNull(Me.txtCasTyp) = False Then
            Forms!frmPICTSMain!txtCaseType = Me.txtCasTyp
        End If
        If IsNull(Me.txtCasTyp) = True Then
            MsgBox "Must Select A Case Type", vbCritical + vbOKOnly, "SELECT CASE TYPE"
        End If
        'Close Dialog box
        DoCmd.Close acForm, "frmGetCaseType"
               
    End Sub

  9. #9
    aytee111 is offline Competent At Times
    Windows 10 Access 2013 64bit
    Join Date
    Nov 2011
    Location
    Nomad
    Posts
    3,936
    I guess you would want to check for validity. Add a DLookup before you populate the main form: something like
    Dim Prov as String
    If fieldname = "P" Then
    Prov=DLookup("Provider","table","something='" & me!txtCasType & "'")
    If IsNull(Prov) then
    MsgBox "..."
    me!txtCasType=Null
    Else
    ...
    etc

  10. #10
    Micron is offline Virtually Inert Person
    Windows 7 32bit Access 2007
    Join Date
    Jun 2014
    Location
    Ontario, Canada
    Posts
    12,737
    A list limit is AFAIK, is roughly 65,000 records. The default setting is 1,000.
    Surely you do not need to load 72,000 records into one list? I would hate to have to scroll through that list!
    The more we hear silence, the more we begin to think about our value in this universe.
    Paraphrase of Professor Brian Cox.

  11. #11
    ocm is offline Advanced Beginner
    Windows 7 32bit Access 2010 32bit
    Join Date
    Mar 2013
    Posts
    39
    Bulzie,

    Thanks for your reply post. I did uncomment & tested it on my dev environment. When the login form opened, I clicked logon (w/o entering my credentials) and it lets me in. Here is part of the code I used:

    Code:
    Private Sub cmdLOGIN_Click()
    'Enable certain options on the main menu screen depending on access level
      DoCmd.OpenForm "frmMainMenu"
      If Me.txtPWD Like "SU*" Then
            Forms!frmMainMenu!optMaintenance.Enabled = False
        Else
            If Me.txtPWD Like "US*" Then
                Forms!frmMainMenu!optReports.Enabled = False
                Forms!frmMainMenu!optSuspCase.Enabled = False
                Forms!frmMainMenu!optMaintenance.Enabled = False
            End If
        End If
       
        Me.Visible = False
       
    End Sub
    TIA,

  12. #12
    Bulzie is offline VIP
    Windows 7 64bit Access 2007
    Join Date
    Nov 2015
    Posts
    1,463
    On the Login form, I'm assuming they have to enter a Password only. So in your Login button on that form, you must check that they entered a value before opening frmMainMenu.

    If Isnull(me.txtPWD) then
    Msgbox "You must enter a valid password"
    Me.txtPWD.Setfocus
    End
    Else
    If me.txtPWD = IN("SU", "US") Then
    Docmd.OpenForm "frmMainMenu
    Else
    Msgbox "Password Invalid, please try again."
    Me.txtPWD.Setfocus
    End
    End If
    End If


    This code needs to run on the OnOpen event of form frmMainMenu

    If Forms!frmLogin.txtPWD Like "SU*" Then
    Forms!frmMainMenu!optMaintenance.Enabled = False
    Else
    If Forms!frmLogin.txtPWD Like "US*" Then
    Forms!frmMainMenu!optReports.Enabled = False
    Forms!frmMainMenu!optSuspCase.Enabled = False
    Forms!frmMainMenu!optMaintenance.Enabled = False
    End If
    End If

    DoCmd.Close acForm, "frmLogin", acSavePrompt

  13. #13
    ocm is offline Advanced Beginner
    Windows 7 32bit Access 2010 32bit
    Join Date
    Mar 2013
    Posts
    39
    Bulzie,

    Thank you. Actually, they have to enter both user name and password.

    TIA,

  14. #14
    ocm is offline Advanced Beginner
    Windows 7 32bit Access 2010 32bit
    Join Date
    Mar 2013
    Posts
    39
    Here is the complete code:
    Code:
    Option Compare Database Public gblUserNm As String Private Sub cmdClose_Click() 'Close The Login and Close Database Once Cancel It Clicked On Error GoTo err_cmdClose_Click DoCmd.Quit Exit_cmdClose_Click: Exit Sub err_cmdClose_Click: MsgBox Err.Description Resume Exit_cmdClose_Click End Sub Private Sub cmdLOGIN_Click() 'Enable certain options on the main menu screen depending on access level DoCmd.OpenForm "frmMainMenu" If Me.txtPWD Like "SU*" Then Forms!frmMainMenu!optMaintenance.Enabled = False Else If Me.txtPWD Like "US*" Then Forms!frmMainMenu!optReports.Enabled = False Forms!frmMainMenu!optSuspCase.Enabled = False Forms!frmMainMenu!optMaintenance.Enabled = False End If End If Me.Visible = False End Sub Private Sub Form_Open(Cancel As Integer) 'Once Form Is Open Enable Everything and Set Focus To User Name Field Application.SetOption "Confirm Action Queries", False Me.txtAttempts = 0 Me.txtUserNm.SetFocus End Sub Private Sub txtPWD_AfterUpdate() 'Password validation Dim db As DAO.Database Dim rstUser As DAO.Recordset Dim strUserNm As String Dim intNum As Integer 'Set db = CurrentDb 'set db to PICTS DB Set db = OpenDatabase("S:\OIG PICTS DB\ADMIN\PICTS DB_be") Set rstUser = db.OpenRecordset("tblLOGIN") strUserNm = txtUserNm rstUser.Index = "USERNM" rstUser.Seek "=", strUserNm If rstUser!EncryptPWD = Me.txtPWD Then 'Enable certain options on the main menu screen depending on access levels If Me.txtPWD = "SU900Sus" Then DoCmd.OpenForm "frmMainMenu" Forms!frmMainMenu!optMaintenance.Enabled = False Forms!frmMainMenu!optMCO.Enabled = True 'DoCmd.Close acForm, "frmLogin" Else If Me.txtPWD Like "su503Eri" Then DoCmd.OpenForm "frmMainMenu" Forms!frmMainMenu!optMCO.Enabled = False Forms!frmMainMenu!optComplaint.Enabled = True Forms!frmMainMenu!optSuspCase.Enabled = False Forms!frmMainMenu!optMaintenance.Enabled = False Else If Me.txtPWD Like "SU*" Then DoCmd.OpenForm "frmMainMenu" Forms!frmMainMenu!optReports.Enabled = True Forms!frmMainMenu!optMaintenance.Enabled = False Forms!frmMainMenu!optMCO.Enabled = False Forms!frmMainMenu!optComplaint.Enabled = False Else If Me.txtPWD Like "us502Mic" Then DoCmd.OpenForm "frmMainMenu" Forms!frmMainMenu!optReports.Enabled = False Forms!frmMainMenu!optComplaint.Enabled = True Forms!frmMainMenu!optSuspCase.Enabled = False Forms!frmMainMenu!optMaintenance.Enabled = False Forms!frmMainMenu!optMCO.Enabled = False Else If Me.txtPWD Like "us501Tan" Then DoCmd.OpenForm "frmMainMenu" Forms!frmMainMenu!optReports.Enabled = False Forms!frmMainMenu!optComplaint.Enabled = True Forms!frmMainMenu!optSuspCase.Enabled = False Forms!frmMainMenu!optMaintenance.Enabled = False Forms!frmMainMenu!optMCO.Enabled = True Else If Me.txtPWD Like "us601Sur" Then DoCmd.OpenForm "frmMainMenu" Forms!frmMainMenu!optReports.Enabled = False Forms!frmMainMenu!optComplaint.Enabled = True Forms!frmMainMenu!optSuspCase.Enabled = False Forms!frmMainMenu!optMaintenance.Enabled = False Forms!frmMainMenu!optMCO.Enabled = False 'DoCmd.Close acForm, "frmLogin" Else If Me.txtPWD Like "US*" Then DoCmd.OpenForm "frmMainMenu" Forms!frmMainMenu!optReports.Enabled = False Forms!frmMainMenu!optComplaint.Enabled = False Forms!frmMainMenu!optMaintenance.Enabled = False Forms!frmMainMenu!optMCO.Enabled = False Else If Me.txtPWD Like "AD*" Then DoCmd.OpenForm "frmMainMenu" 'DoCmd.Close acForm, "frmLogin" Else If Me.txtPWD = "oig901ml" Then DoCmd.OpenForm "frmMainMenu" Forms!frmMainMenu!optMaintenance.Enabled = False End If End If End If End If End If End If End If End If End If Else MsgBox "Password Is Invalid - Try Again!", vbCritical + vbOKOnly, "INVALID PASSWORD" Me.txtInvalidPW = "Y" Me.txtAttempts = Me.txtAttempts + 1 If Me.txtAttempts = 3 Then MsgBox "Check Password And Try Again" & vbCrLf & " GOOD-BYE", vbCritical + vbOKOnly, "TRY AGAIN LATER" DoCmd.Quit Else Me.txtPWD.SetFocus Me.cmdLOGIN.Enabled = False End If End If End Sub Private Sub txtUserNm_AfterUpdate() 'User validation Dim db As DAO.Database Dim rstUser As DAO.Recordset Dim strUserNm As String 'Set db = CurrentDb 'set db to PICTS DB Set db = OpenDatabase("S:\OIG PICTS DB\ADMIN\PICTS DB_be") Set rstUser = db.OpenRecordset("tblLOGIN") strUserNm = Me.txtUserNm gblUserNm = Me.txtUserNm rstUser.Index = "USERNM" rstUser.Seek "=", strUserNm If rstUser.NoMatch = False Then Me.txtPWD.Enabled = True Me.txtPWD.SetFocus Me.txtValidUser = "Y" Else MsgBox "No Match For User Name " & strUserNm, vbInformation + vbOKOnly, "INVALID USER NAME" Me.txtAttempts = Me.txtAttempts + 1 If Me.txtAttempts = 3 Then MsgBox "Check User Name And Try Again" & vbCrLf & " GOOD-BYE", vbCritical + vbOKOnly, "TRY AGAIN LATER" DoCmd.Close Else Me.txtUserNm = Null Me.txtUserNm.SetFocus End If End If End Sub Private Sub txtUserNm_BeforeUpdate(Cancel As Integer) 'Check To See If User Are Valid. Look Into The Table To Get User Status Dim strUser As String Dim strStatus As String Dim strSQL As String Dim db As DAO.Database Dim rstStatus As DAO.Recordset Set db = OpenDatabase("S:\OIG PICTS DB\ADMIN\PICTS DB_be") Set rstStatus = db.OpenRecordset("tblLOGIN") strUser = Me.txtUserNm rstStatus.Index = "USERNM" rstStatus.Seek "=", strUser If rstStatus!STATUS = "A" Then strStatus = rstStatus!STATUS Me.txtStatus = strStatus End If If Me.txtStatus = "A" Then Me.txtPWD.Enabled = True ' Me.txtPWD.SetFocus Me.txtValidUser = "Y" Else MsgBox "Invalid User Name Try Again" & vbCrLf & " GOOD-BYE", vbCritical + vbOKOnly, "TRY AGAIN LATER" Me.txtValidUser = "N" Me.txtPWD.Enabled = False Me.cmdLOGIN.Enabled = False DoCmd.Quit End If End Sub Private Sub txtUserNm_GotFocus() 'Check Users Information If Valid Then Set Focus To Password Otherwise Close If Me.txtValidUser = "Y" And Me.txtInvalidPW = "Y" Then Me.txtPWD.SetFocus End If End Sub Option Compare Database Public gblUserNm As String Private Sub cmdClose_Click() 'Close The Login and Close Database Once Cancel It Clicked On Error GoTo err_cmdClose_Click DoCmd.Quit Exit_cmdClose_Click: Exit Sub err_cmdClose_Click: MsgBox Err.Description Resume Exit_cmdClose_Click End Sub Private Sub cmdLOGIN_Click() 'Enable certain options on the main menu screen depending on access level DoCmd.OpenForm "frmMainMenu" If Me.txtPWD Like "SU*" Then Forms!frmMainMenu!optMaintenance.Enabled = False Else If Me.txtPWD Like "US*" Then Forms!frmMainMenu!optReports.Enabled = False Forms!frmMainMenu!optSuspCase.Enabled = False Forms!frmMainMenu!optMaintenance.Enabled = False End If End If Me.Visible = False End Sub Private Sub Form_Open(Cancel As Integer) 'Once Form Is Open Enable Everything and Set Focus To User Name Field Application.SetOption "Confirm Action Queries", False Me.txtAttempts = 0 Me.txtUserNm.SetFocus End Sub Private Sub txtPWD_AfterUpdate() 'Password validation Dim db As DAO.Database Dim rstUser As DAO.Recordset Dim strUserNm As String Dim intNum As Integer 'Set db = CurrentDb 'set db to PICTS DB Set db = OpenDatabase("S:\OIG PICTS DB\ADMIN\PICTS DB_be") Set rstUser = db.OpenRecordset("tblLOGIN") strUserNm = txtUserNm rstUser.Index = "USERNM" rstUser.Seek "=", strUserNm If rstUser!EncryptPWD = Me.txtPWD Then 'Enable certain options on the main menu screen depending on access levels If Me.txtPWD = "SU900Sus" Then DoCmd.OpenForm "frmMainMenu" Forms!frmMainMenu!optMaintenance.Enabled = False Forms!frmMainMenu!optMCO.Enabled = True 'DoCmd.Close acForm, "frmLogin" Else If Me.txtPWD Like "su503Eri" Then DoCmd.OpenForm "frmMainMenu" Forms!frmMainMenu!optMCO.Enabled = False Forms!frmMainMenu!optComplaint.Enabled = True Forms!frmMainMenu!optSuspCase.Enabled = False Forms!frmMainMenu!optMaintenance.Enabled = False Else If Me.txtPWD Like "SU*" Then DoCmd.OpenForm "frmMainMenu" Forms!frmMainMenu!optReports.Enabled = True Forms!frmMainMenu!optMaintenance.Enabled = False Forms!frmMainMenu!optMCO.Enabled = False Forms!frmMainMenu!optComplaint.Enabled = False Else If Me.txtPWD Like "us502Mic" Then DoCmd.OpenForm "frmMainMenu" Forms!frmMainMenu!optReports.Enabled = False Forms!frmMainMenu!optComplaint.Enabled = True Forms!frmMainMenu!optSuspCase.Enabled = False Forms!frmMainMenu!optMaintenance.Enabled = False Forms!frmMainMenu!optMCO.Enabled = False Else If Me.txtPWD Like "us501Tan" Then DoCmd.OpenForm "frmMainMenu" Forms!frmMainMenu!optReports.Enabled = False Forms!frmMainMenu!optComplaint.Enabled = True Forms!frmMainMenu!optSuspCase.Enabled = False Forms!frmMainMenu!optMaintenance.Enabled = False Forms!frmMainMenu!optMCO.Enabled = True Else If Me.txtPWD Like "us601Sur" Then DoCmd.OpenForm "frmMainMenu" Forms!frmMainMenu!optReports.Enabled = False Forms!frmMainMenu!optComplaint.Enabled = True Forms!frmMainMenu!optSuspCase.Enabled = False Forms!frmMainMenu!optMaintenance.Enabled = False Forms!frmMainMenu!optMCO.Enabled = False 'DoCmd.Close acForm, "frmLogin" Else If Me.txtPWD Like "US*" Then DoCmd.OpenForm "frmMainMenu" Forms!frmMainMenu!optReports.Enabled = False Forms!frmMainMenu!optComplaint.Enabled = False Forms!frmMainMenu!optMaintenance.Enabled = False Forms!frmMainMenu!optMCO.Enabled = False Else If Me.txtPWD Like "AD*" Then DoCmd.OpenForm "frmMainMenu" 'DoCmd.Close acForm, "frmLogin" Else If Me.txtPWD = "oig901ml" Then DoCmd.OpenForm "frmMainMenu" Forms!frmMainMenu!optMaintenance.Enabled = False End If End If End If End If End If End If End If End If End If Else MsgBox "Password Is Invalid - Try Again!", vbCritical + vbOKOnly, "INVALID PASSWORD" Me.txtInvalidPW = "Y" Me.txtAttempts = Me.txtAttempts + 1 If Me.txtAttempts = 3 Then MsgBox "Check Password And Try Again" & vbCrLf & " GOOD-BYE", vbCritical + vbOKOnly, "TRY AGAIN LATER" DoCmd.Quit Else Me.txtPWD.SetFocus Me.cmdLOGIN.Enabled = False End If End If End Sub Private Sub txtUserNm_AfterUpdate() 'User validation Dim db As DAO.Database Dim rstUser As DAO.Recordset Dim strUserNm As String 'Set db = CurrentDb 'set db to PICTS DB Set db = OpenDatabase("S:\OIG PICTS DB\ADMIN\PICTS DB_be") Set rstUser = db.OpenRecordset("tblLOGIN") strUserNm = Me.txtUserNm gblUserNm = Me.txtUserNm rstUser.Index = "USERNM" rstUser.Seek "=", strUserNm If rstUser.NoMatch = False Then Me.txtPWD.Enabled = True Me.txtPWD.SetFocus Me.txtValidUser = "Y" Else MsgBox "No Match For User Name " & strUserNm, vbInformation + vbOKOnly, "INVALID USER NAME" Me.txtAttempts = Me.txtAttempts + 1 If Me.txtAttempts = 3 Then MsgBox "Check User Name And Try Again" & vbCrLf & " GOOD-BYE", vbCritical + vbOKOnly, "TRY AGAIN LATER" DoCmd.Close Else Me.txtUserNm = Null Me.txtUserNm.SetFocus End If End If End Sub Private Sub txtUserNm_BeforeUpdate(Cancel As Integer) 'Check To See If User Are Valid. Look Into The Table To Get User Status Dim strUser As String Dim strStatus As String Dim strSQL As String Dim db As DAO.Database Dim rstStatus As DAO.Recordset Set db = OpenDatabase("S:\OIG PICTS DB\ADMIN\PICTS DB_be") Set rstStatus = db.OpenRecordset("tblLOGIN") strUser = Me.txtUserNm rstStatus.Index = "USERNM" rstStatus.Seek "=", strUser If rstStatus!STATUS = "A" Then strStatus = rstStatus!STATUS Me.txtStatus = strStatus End If If Me.txtStatus = "A" Then Me.txtPWD.Enabled = True ' Me.txtPWD.SetFocus Me.txtValidUser = "Y" Else MsgBox "Invalid User Name Try Again" & vbCrLf & " GOOD-BYE", vbCritical + vbOKOnly, "TRY AGAIN LATER" Me.txtValidUser = "N" Me.txtPWD.Enabled = False Me.cmdLOGIN.Enabled = False DoCmd.Quit End If End Sub Private Sub txtUserNm_GotFocus() 'Check Users Information If Valid Then Set Focus To Password Otherwise Close If Me.txtValidUser = "Y" And Me.txtInvalidPW = "Y" Then Me.txtPWD.SetFocus End If End Sub

  15. #15
    CJ_London is offline VIP
    Windows 10 Access 2010 32bit
    Join Date
    Mar 2015
    Posts
    11,398
    cross posted here with answers

    https://www.access-programmers.co.uk...t=72000&page=2

    ocm/danny - please read this link http://www.excelguru.ca/content.php?184

Page 1 of 2 12 LastLast
Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 2
    Last Post: 04-20-2016, 11:47 AM
  2. Replies: 2
    Last Post: 04-19-2016, 10:11 PM
  3. Replies: 3
    Last Post: 06-04-2014, 10:54 AM
  4. Drop-down list values selection
    By Haleakala17 in forum Forms
    Replies: 2
    Last Post: 09-29-2012, 03:59 PM
  5. Replies: 2
    Last Post: 02-13-2010, 01:54 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums