User Login / Verify Permissions / Open Permissions Based Form / Access 2007

[cobra35y]

Good Afternoon, I am new to the world of programming. after reviewing this site for info pertaining to my situation, i have declared a loss and posting for help. maybe i am just overlooking the situation, maybe just need a second set of eyes on this. i am in the military and have designed a unit database that allows for all kinds of tracking and reports generation for training meetings to licensing of soldiers on equipment and other administrative functions. However this database contains personal information that needs to be secured to allow only authorized users that work in the main office. this database will be placed on a network share so that all authorized users will be able to access it as needed for daily operations. my baseline was SD2 a few years ago but after a few years of using it and continuing upgrades and new units, i am required to increase the security.

Situation: All users have a smart card that they use to login to their Desktop. I have code that checks for the Windows login ID and matching that users permissions based on security level authorized and i have the baseline login screen using the code found in lots of locations on the web. now i need to make it so that only certain options are available to basic users.

Question:
I want to get rid of the password login, since the user will be authenticated by their smartcard login to windows. however how do i make it possible for the login button to check that username against the security level authorized per their ID name and then open their form and only their forms?

Possibilities:
i would love to share this database with anyone interested if they dont mind helping me with better solutions on the login funcionality in access 2007. it is hard for me to get the reference materials i need as i am stationed in korea. i have the database preped for dissemination to other programmers, i have removed all the soldier info from tables so you can play with it however you want. i have worked on this since 2007 at my last unit, it is just time to upgrade this baby for transferability to other units and still be able to maintain security.

i would post code here but dont know where to begin.

the database is in ACCDB format using Access 07, i am also learning VB 8 express, downloaded it yesterday, really trying to get a better grip on VBA Programming. but the database has sort of a deadline before they scrap the idea all together.


Any help would be great, i will send this out to anyone requesting it in a .zip file. size right now is 27MB.

contact me directly at
[e-mail]

or

[e-mail]

Thank you in advance for your time and help.

[cobra35y]

when opening the database this is the first code that runs opening my splash screen, A form with timer event to open the login screen.

Option Compare Database
 
'------------------------------------------------------------
' Form_Timer
'
'------------------------------------------------------------
Private Sub Form_Timer()
On Error GoTo Form_Timer_Err
 
    DoCmd.OpenForm "loginscreen", acNormal, "", "", , acNormal
    Exit Sub
 
 
Form_Timer_Exit:
    Exit Sub
 
Form_Timer_Err:
    MsgBox Error$
    Resume Form_Timer_Exit
 
End Sub

[cobra35y]

Using an unbound table "Account Table"consiting of "ID" AutoNumber column "Username" Column and "Password" column. the form.loginscreen retrieves data from the table.Account Table.

the form consists of 1 combobox bound to the username column on account table and 1 unbound textbox named Password used for password input. also on the form is a command button titled exit database and 1 command button titled login.

Obviously the Login Button with command on_click is bound to an event in the below code initiating the process to verify the username to the password located in the Account Table. which works right now just fine with one exception

when initially getting the loginscreen, i get to select my username, however, when i type in the username it is overwriting the other fields in the account table. however if the username has is in the drop down and unique by means in which it has not been over written then the username and password works fine and continues to the switchboard. otherwise 'Else happens.

Option Compare Database
 
Private Sub Combo11_AfterUpdate()
'After selecting user name set focus to password field
    Forms!LoginScreen!Password.SetFocus
End Sub
 
Private Sub Command5_Click()
'Check to see if data is entered into the UserName combo box
 
    If IsNull(Forms!LoginScreen!Combo11) Or Forms!LoginScreen!Combo11 = "" Then
      MsgBox "You must enter a User Name.", vbOKOnly, "Required Data"
        Forms!LoginScreen!Combo11.SetFocus
        Exit Sub
    End If
 
    'Check to see if data is entered into the password box
 
    If IsNull(Forms!LoginScreen!Password) Or Forms!LoginScreen!Password = "" Then
      MsgBox "You must enter a Password.", vbOKOnly, "Required Data"
        Forms!LoginScreen!Password.SetFocus
        Exit Sub
    End If
 
    'Check value of password in AccountTable to see if this
    'matches value chosen in combo box
 
    If Forms!LoginScreen!Password.Value = DLookup("Password", "AccountTable", "[UserName]= '" & Forms!LoginScreen!Combo11.Value & "'") Then
 
        'Close logon form and open Switchboard
 
        DoCmd.Close acForm, "LoginScreen", acSaveNo
        DoCmd.OpenForm "Switchboard"
 
    Else
      MsgBox "Password Invalid. Please Try Again", vbOKOnly, _
            "Invalid Entry!"
        Forms!LoginScreen!Password.SetFocus
    End If
 
    'If User Enters incorrect password 3 times database will shutdown
 
    intLogonAttempts = intLogonAttempts + 1
    If intLogonAttempts > 3 Then
      MsgBox "You do not have access to this database.Please contact admin.", _
               vbCritical, "Restricted Access!"
        Application.Quit
    End If
 
End Sub

[cobra35y]

This is the code for the Switchboard however line 319 below is where once the password has been verified it opens the switchboard causing on Load the form closes the Splash Screen preventing further looping of the loginscreen. if the loginscreen is attempted to be bypassed then it continues to cycle and loop until closed by the switchboard being loaded. so this is where i want to enable only the authorized forms or buttons based on security level. should i add a security level table and link to the username in the account table, and code the switchboard buttons so they are available to only those specified users, or would it be best to get rid of the switchboard and have user based forms with their allowed buttons.

the office only consists of approx. 15 soldiers, however this might be ok if it would be the same 15 forever, but simply not the case the soldiers depart after 1 year of assignment to korea. so each user having individual form i cant see feasable, unless maybe a general user form for certain departments and assigning a permission level to each of the department forms. that may be an idea.

let me know what yall think, i am in the wind right now, and i know there must be something i am overlooking for a solution to my dilema. thanks for any and all help.

Option Compare Database
 
Private Sub Form_Open(Cancel As Integer)
' Minimize the database window and initialize the form.
 
    ' Move to the switchboard page that is marked as the default.
    Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Default' "
    Me.FilterOn = True
 
End Sub
 
Private Sub Form_Current()
' Update the caption and fill in the list of options.
 
    Me.Caption = Nz(Me![ItemText], "")
    FillOptions
 
End Sub
 
Private Sub FillOptions()
' Fill in the options for this switchboard page.
 
    ' The number of buttons on the form.
    Const conNumButtons = 8
 
    Dim con As Object
    Dim RS As Object
    Dim stSql As String
    Dim intOption As Integer
 
    ' Set the focus to the first button on the form,
    ' and then hide all of the buttons on the form
    ' but the first.  You can't hide the field with the focus.
    Me![Option1].SetFocus
    For intOption = 2 To conNumButtons
        Me("Option" & intOption).Visible = False
        Me("OptionLabel" & intOption).Visible = False
    Next intOption
 
    ' Open the table of Switchboard Items, and find
    ' the first item for this Switchboard Page.
    Set con = Application.CurrentProject.Connection
    stSql = "SELECT * FROM [Switchboard Items]"
    stSql = stSql & " WHERE [ItemNumber] > 0 AND [SwitchboardID]=" & Me![SwitchboardID]
    stSql = stSql & " ORDER BY [ItemNumber];"
    Set RS = CreateObject("ADODB.Recordset")
    RS.Open stSql, con, 1   ' 1 = adOpenKeyset
 
    ' If there are no options for this Switchboard Page,
    ' display a message.  Otherwise, fill the page with the items.
    If (RS.EOF) Then
        Me![OptionLabel1].Caption = "There are no items for this switchboard page"
    Else
        While (Not (RS.EOF))
            Me("Option" & RS![ItemNumber]).Visible = True
            Me("OptionLabel" & RS![ItemNumber]).Visible = True
            Me("OptionLabel" & RS![ItemNumber]).Caption = RS![ItemText]
            RS.MoveNext
        Wend
    End If
 
    ' Close the recordset and the database.
    RS.Close
    Set RS = Nothing
    Set con = Nothing
 
End Sub
 
Private Function HandleButtonClick(intBtn As Integer)
' This function is called when a button is clicked.
' intBtn indicates which button was clicked.
 
    ' Constants for the commands that can be executed.
    Const conCmdGotoSwitchboard = 1
    Const conCmdOpenFormAdd = 2
    Const conCmdOpenFormBrowse = 3
    Const conCmdOpenReport = 4
    Const conCmdCustomizeSwitchboard = 5
    Const conCmdExitApplication = 6
    Const conCmdRunMacro = 7
    Const conCmdRunCode = 8
    Const conCmdOpenPage = 9
 
    ' An error that is special cased.
    Const conErrDoCmdCancelled = 2501
 
    Dim con As Object
    Dim RS As Object
    Dim stSql As String
 
On Error GoTo HandleButtonClick_Err
 
    ' Find the item in the Switchboard Items table
    ' that corresponds to the button that was clicked.
    Set con = Application.CurrentProject.Connection
    Set RS = CreateObject("ADODB.Recordset")
    stSql = "SELECT * FROM [Switchboard Items] "
    stSql = stSql & "WHERE [SwitchboardID]=" & Me![SwitchboardID] & " AND [ItemNumber]=" & intBtn
    RS.Open stSql, con, 1    ' 1 = adOpenKeyset
 
    ' If no item matches, report the error and exit the function.
    If (RS.EOF) Then
        MsgBox "There was an error reading the Switchboard Items table."
        RS.Close
        Set RS = Nothing
        Set con = Nothing
        Exit Function
    End If
 
    Select Case RS![Command]
 
        ' Go to another switchboard.
        Case conCmdGotoSwitchboard
            Me.Filter = "[ItemNumber] = 0 AND [SwitchboardID]=" & RS![Argument]
 
        ' Open a form in Add mode.
        Case conCmdOpenFormAdd
            DoCmd.OpenForm RS![Argument], , , , acAdd
 
        ' Open a form.
        Case conCmdOpenFormBrowse
            DoCmd.OpenForm RS![Argument]
 
        ' Open a report.
        Case conCmdOpenReport
            DoCmd.OpenReport RS![Argument], acPreview
 
        ' Customize the Switchboard.
        Case conCmdCustomizeSwitchboard
            ' Handle the case where the Switchboard Manager
            ' is not installed (e.g. Minimal Install).
            On Error Resume Next
            Application.Run "ACWZMAIN.sbm_Entry"
            If (Err <> 0) Then MsgBox "Command not available."
            On Error GoTo 0
            ' Update the form.
            Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Default' "
            Me.Caption = Nz(Me![ItemText], "")
            FillOptions
 
        ' Exit the application.
        Case conCmdExitApplication
            CloseCurrentDatabase
 
        ' Run a macro.
        Case conCmdRunMacro
            DoCmd.RunMacro RS![Argument]
 
        ' Run code.
        Case conCmdRunCode
            Application.Run RS![Argument]
 
        ' Open a Data Access Page
        Case conCmdOpenPage
            DoCmd.OpenDataAccessPage RS![Argument]
 
        ' Any other command is unrecognized.
        Case Else
            MsgBox "Unknown option."
 
    End Select
 
    ' Close the recordset and the database.
    RS.Close
 
HandleButtonClick_Exit:
On Error Resume Next
    Set RS = Nothing
    Set con = Nothing
    Exit Function
 
HandleButtonClick_Err:
    ' If the action was cancelled by the user for
    ' some reason, don't display an error message.
    ' Instead, resume on the next line.
    If (Err = conErrDoCmdCancelled) Then
        Resume Next
    Else
        MsgBox "There was an error executing the command.", vbCritical
        Resume HandleButtonClick_Exit
    End If
 
End Function
 
Private Sub Command35_Click()
On Error GoTo Err_Command35_Click
 
    Dim stDocName As String
    Dim stLinkCriteria As String
 
    stDocName = "SPECIAL QUERIES"
    DoCmd.OpenForm stDocName, , , stLinkCriteria
 
Exit_Command35_Click:
    Exit Sub
 
Err_Command35_Click:
    MsgBox Err.Description
    Resume Exit_Command35_Click
 
End Sub
Private Sub Command36_Click()
On Error GoTo Err_Command36_Click
 
    Dim stDocName As String
 
    stDocName = "PT Avg"
    DoCmd.OpenQuery stDocName, acNormal, acEdit
 
Exit_Command36_Click:
    Exit Sub
 
Err_Command36_Click:
    MsgBox Err.Description
    Resume Exit_Command36_Click
 
End Sub
Private Sub Command37_Click()
On Error GoTo Err_Command37_Click
 
    Dim stDocName As String
 
    stDocName = "B CO APFT FAILURES"
    DoCmd.OpenQuery stDocName, acNormal, acEdit
 
Exit_Command37_Click:
    Exit Sub
 
Err_Command37_Click:
    MsgBox Err.Description
    Resume Exit_Command37_Click
 
End Sub
Private Sub Command38_Click()
On Error GoTo Err_Command38_Click
 
    Dim stDocName As String
 
    stDocName = "New soldier Query"
    DoCmd.OpenQuery stDocName, acNormal, acEdit
 
Exit_Command38_Click:
    Exit Sub
 
Err_Command38_Click:
    MsgBox Err.Description
    Resume Exit_Command38_Click
 
End Sub
Private Sub Mass_Delete_Click()
On Error GoTo Err_Mass_Delete_Click
 
    Dim stDocName As String
 
    stDocName = "Mass Delete Complete Record"
    DoCmd.RunMacro stDocName
 
Exit_Mass_Delete_Click:
    Exit Sub
 
Err_Mass_Delete_Click:
    MsgBox Err.Description
    Resume Exit_Mass_Delete_Click
 
End Sub
Private Sub Command49_Click()
On Error GoTo Err_Command49_Click
 
    Dim stDocName As String
 
    stDocName = "OPS New soldier Query"
    DoCmd.OpenQuery stDocName, acNormal, acEdit
 
Exit_Command49_Click:
    Exit Sub
 
Err_Command49_Click:
    MsgBox Err.Description
    Resume Exit_Command49_Click
 
End Sub
Private Sub Command50_Click()
On Error GoTo Err_Command50_Click
 
    Dim stDocName As String
 
    stDocName = "TRAINING APFT Scores"
    DoCmd.OpenQuery stDocName, acNormal, acEdit
 
Exit_Command50_Click:
    Exit Sub
 
Err_Command50_Click:
    MsgBox Err.Description
    Resume Exit_Command50_Click
 
End Sub
Private Sub OPS_MENU_Click()
On Error GoTo Err_OPS_MENU_Click
 
    Dim stDocName As String
    Dim stLinkCriteria As String
 
    stDocName = "OPERATIONS MENU"
    DoCmd.OpenForm stDocName, , , stLinkCriteria
 
Exit_OPS_MENU_Click:
    Exit Sub
 
Err_OPS_MENU_Click:
    MsgBox Err.Description
    Resume Exit_OPS_MENU_Click
 
End Sub
'------------------------------------------------------------
' Form_Load
'
'------------------------------------------------------------
Private Sub Form_Load()
On Error GoTo Form_Load_Err
 
    DoCmd.Close acForm, "radioactive sergeant productions"
 
 
Form_Load_Exit:
    Exit Sub
 
Form_Load_Err:
    MsgBox Error$
    Resume Form_Load_Exit
 
End Sub

[cobra35y]

too much code and too many questions to truly post. lol, you really have to see the database in its current state to understand what i am going for.