Inlogscherm voor meerdere gebruikers

Status
Niet open voor verdere reacties.
K

kruimeltjes

Gebruiker
Lid geworden
30 sep 2009
Berichten
222
Ik heb na enige speuren op het forum volgende item gevonden

(http://www.helpmij.nl/forum/showthr...s?p=3752325&highlight=inlogscherm#post3752325)

Dit is precies wat ik wil gaan gebruiken maar hier wordt (volgens mij) gebruik gemaakt van maar 2 soorten gebruikers terwijl ik er 3 heb.

De VBA code die in de portfolia.rar staat moet ik dus aanpassen (mod_display_menu) maar ik zie niet helemaal waar ik dat moet doen.

Wil iemand mij een handje op weg helpen?

Groetjes,

Simone
 
En toch is het aanpassen van de code niet zo heel ingewikkeld....
Het geposte voorbeeld is een stukkie ingewikkelder dan normaal, omdat er op twee niveaus gecontroleerd wordt. Voor de meeste db's is één niveau wel genoeg. En dan krijg je de volgende structuur:

Code: 
      Select Case AccessLevel
           Case 1 ' level1 menu
           Case 2  ' level2 menu
           Case 3  ' level3 menu
           Case 4  ' level4 menu
           Case 5  ' level5 menu
           Case Else
                    strMsg = " Access Denied" & vbCrLf & "Contact your Administrator if the problem persists."
                    MsgBox strMsg, vbInformation, "INVALID USER ID or PASSWORD"
      End Select

Voor elk niveau kun je verschillende formulieren laten openen, of verschillende manieren waarop iemand iets mag doen. Bij Level5 mag je bijvoorbeeld Toevoegen en verwijderen, bij Level2 alleen toevoegen.
 
Ik heb deze code nu aangepast maar krijg nu een fout melding te zien; compileer fout Case zonder select case.

Moet ik nog meer dingen aanpassen?

Groetjes,

Simone
 
Kun je de code posten die je gebruikt?
 
Code: 
Option Compare Database
Option Explicit



Function DisplayMenu(UserId As Variant)
''On Error GoTo err_display_menu
   
' at this stage the userId and access level has been checked
Dim AccessLevel As Integer
Dim FinishDate As Date
Dim PortSyd As String
Dim ValidUser As Integer
Dim CheckUser As Integer
Dim PasswordPeriod As Date
Dim CheckPassword As String
Dim strmsg As String
Dim strSQL As String, sFilter As String
ValidUser = 2

' *****************************************************************************************************************
' validate user_id
' *****************************************************************************************************************
strSQL = "SELECT [initials],[password],[access_level],[password_date] FROM tbl_users " _
    & "WHERE initials=" & Forms!Frm_Login!Initials
''strSQL = "SELECT [personeelsnummer],[passwords] FROM tbl_users WHERE personeelsnummer=" & PersNr
Dim tmp
''tmp = InputBox("", "", strSQL)

With CurrentDb.OpenRecordset(strSQL)
    If .RecordCount = 1 Then
        ValidUser = 2
        If .Fields("password") = Forms!Frm_Login!Password Then
            AccessLevel = .Fields("Access_Level").Value
            PasswordPeriod = CDate(.Fields("password_date").Value)
        Else
            ValidUser = 1
            AccessLevel = 4
        End If
    Else
        ValidUser = 0
    End If
    .Close
End With

' *****************************************************************************************************************
' validate access_level
' *****************************************************************************************************************
Select Case ValidUser
    Case 0, 1
            strmsg = " Access Denied" & vbCrLf & " Contact your Administrator if the problem persists.   "
            MsgBox strmsg, vbInformation, "INVALID USER ID or PASSWORD"
           ' DoCmd.Quit
    Case 2
        Select Case AccessLevel
           Case 1 ' lv1 menu
                ' validate password expiry
                  If PasswordPeriod < Date - 30 Then
                        strmsg = "Your password has expired. You must change your password"
                        MsgBox strmsg, vbInformation, "Expired Password"
                        DoCmd.OpenForm "Frm_change_password", acNormal
                    Else
                        DoCmd.Close acForm, "Frm_Login"
                        DoCmd.OpenForm "Frm_switchboard_lv1"
                    End If
             Case 2 ' lv2 menu
                ' validate password expiry
                  If PasswordPeriod < Date - 30 Then
                        strmsg = "Your password has expired. You must change your password"
                        MsgBox strmsg, vbInformation, "Expired Password"
                        DoCmd.OpenForm "Frm_change_password", acNormal
                    Else
                        DoCmd.Close acForm, "Frm_Login"
                        DoCmd.OpenForm "Frm_switchboard_lv2"
              Case 3 ' lv3 menu
                ' validate password expiry
                  If PasswordPeriod < Date - 30 Then
                        strmsg = "Your password has expired. You must change your password"
                        MsgBox strmsg, vbInformation, "Expired Password"
                        DoCmd.OpenForm "Frm_change_password", acNormal
                    Else
                        DoCmd.Close acForm, "Frm_Login"
                        DoCmd.OpenForm "Frm_switchboard_lv3"
                    End If
            Case Else
                    strmsg = " Access Denied" & vbCrLf & "Contact your Administrator if the problem persists."
                    MsgBox strmsg, vbInformation, "INVALID USER ID or PASSWORD"
        End Select
    Case Else
End Select

''' close main form frm_main
''    DoCmd.Close acForm, "frm_main"
    
exit_display_menu:
    Exit Function
    
err_display_menu:
    MsgBox Err.Description
    Resume exit_display_menu

End Function
Sub Display_Menu()
On Error GoTo err_display_menu
   
' at this stage the userId and access level has been checked
Dim access_level As Integer
Dim Finish_Date As Date
Dim Port_Syd As String
Dim Valid_User As Integer
Dim Check_User As Integer
Dim Password_Period As Date
Dim Check_Password As String
Dim strmsg As String

Valid_User = 2

' **********************************************
' validate user_id
' **********************************************
Check_User = DCount("[UserID]", "Tbl_users", "Initials=" & Forms!Frm_Login!Initials & "")
    If Check_User = 1 Then
        Valid_User = 2
    Else
        Valid_User = 0
   End If
    
' **********************************************
' validate password
' **********************************************
If Valid_User = 2 Then
   Check_Password = DLookup("[password]", "Tbl_users", "Initials=" & Forms!Frm_Login!Initials & "")
   If UCase(Check_Password) = UCase(Forms!Frm_Login!Password) Then
        Valid_User = 2
   Else
        Valid_User = 1
   End If
End If

' **********************************************
' validate access_level
' **********************************************
If Valid_User = 2 Then
    access_level = DLookup("[access_level]", "Tbl_users", "Initials=" & Forms!Frm_Login!Initials & "")
End If

Select Case Valid_User
    Case 0, 1
            strmsg = " Access Denied" & vbCrLf & " Contact your Administrator if the problem persists.   "
            MsgBox strmsg, vbInformation, "INVALID USER ID or PASSWORD"
           ' DoCmd.Quit
    Case 2
            Select Case access_level
               Case 1 ' level1 menu
                    ' validate password expiry
                      Password_Period = DLookup("[password_date]", "Tbl_users", "initials=" & Forms!Frm_Login!Initials & "")
                      If Password_Period < Date - 30 Then
                            strmsg = " Your password has expired. You must change your password"
                            MsgBox strmsg, vbInformation, "Expired Password"
                            DoCmd.OpenForm "Frm_change_password", acNormal
                        Else
                            DoCmd.OpenForm "Frm_switchboard_lv1"
                        End If
               Case 2 ' level2 menu
                    ' validate password expiry
                      Password_Period = DLookup("[password_date]", "tbl_users", "personeelsnummer=" & Forms!Frm_Login!Initials & "")
                      If Password_Period < Date - 30 Then
                            strmsg = " Your password has expired. You must change your password"
                            MsgBox strmsg, vbInformation, "Expired Password"
                            DoCmd.OpenForm "Frm_change_password", acNormal
                        Else
                            DoCmd.OpenForm "Frm_switchboard_lv2"
                        End If
                 Case 3 ' level3 menu
                    ' validate password expiry
                      Password_Period = DLookup("[password_date]", "Tbl_users", "personeelsnummer=" & Forms!Frm_Login!Initials & "")
                      If Password_Period < Date - 30 Then
                            strmsg = " Your password has expired. You must change your password"
                            MsgBox strmsg, vbInformation, "Expired Password"
                            DoCmd.OpenForm "Frm_change_password", acNormal
                        Else
                            DoCmd.OpenForm "Frm_switchboard_lv3"
                        End If
                Case Else
                        strmsg = " Access Denied" & vbCrLf & " Contact your Administrator if the problem persists.   "
                        MsgBox strmsg, vbInformation, "INVALID USER ID or PASSWORD"
            End Select
End Select

' close main form frm_main
    DoCmd.Close acForm, "frm_Login"
    
exit_display_menu:
    Exit Sub
    
err_display_menu:
    MsgBox Err.Description
    Resume exit_display_menu

End Sub

Dit is de code die ik gebruik (overgenomen van de hiervoor aangegeven topic)
 
Ik zie er zo op he eerste gezicht geen fout in; op welke regel blijft de foutopsporing staan?
 
Code: 
'***************************************************************** ************************************************
' validate access_level
' *****************************************************************************************************************
Select Case ValidUser
    Case 0, 1
            strmsg = " Access Denied" & vbCrLf & " Contact your Administrator if the problem persists.   "
            MsgBox strmsg, vbInformation, "INVALID USER ID or PASSWORD"
           ' DoCmd.Quit
    Case 2
        Select Case AccessLevel
           Case 1 ' lv1 menu
                ' validate password expiry
                  If PasswordPeriod < Date - 30 Then
                        strmsg = "Your password has expired. You must change your password"
                        MsgBox strmsg, vbInformation, "Expired Password"
                        DoCmd.OpenForm "Frm_change_password", acNormal
                    Else
                        DoCmd.Close acForm, "Frm_Login"
                        DoCmd.OpenForm "Frm_switchboard_lv1"
                    End If
             Case 2 ' lv2 menu
                ' validate password expiry
                  If PasswordPeriod < Date - 30 Then
                        strmsg = "Your password has expired. You must change your password"
                        MsgBox strmsg, vbInformation, "Expired Password"
                        DoCmd.OpenForm "Frm_change_password", acNormal
                    Else
                        DoCmd.Close acForm, "Frm_Login"
                        DoCmd.OpenForm "Frm_switchboard_lv2"
              Case 3 ' lv3 menu
                ' validate password expiry
                  If PasswordPeriod < Date - 30 Then
                        strmsg = "Your password has expired. You must change your password"
                        MsgBox strmsg, vbInformation, "Expired Password"
                        DoCmd.OpenForm "Frm_change_password", acNormal
                    Else
                        DoCmd.Close acForm, "Frm_Login"
                        DoCmd.OpenForm "Frm_switchboard_lv3"
                    End If
            Case Else
                    strmsg = " Access Denied" & vbCrLf & "Contact your Administrator if the problem persists."
                    MsgBox strmsg, vbInformation, "INVALID USER ID or PASSWORD"
        End Select
    Case Else
End Select

Case 3 geeft die de foutmelding
 
En bij welke regel? Kun je, als je de muis boven AccessLevel houdt, zien of er überhaupt wat is toegewezen aan AccessLevel?
 
Ik probeer de database even up te loaden misschien dat dat wat makkelijker kijken is
 
Ik wacht af... Als hij te groot is, mag je 'm ook wel mailen.
 
Simpel foutje.... Had ik nog kunnen zien ook aan de code. Blinde vink da'k er ben... Je bent een End IF vergeten bij het Case 2
End If
Case 3 ' lv3 menu
 
oke hij geeft nu inderdaad niet meer de fout die ik eerst had maar nu geeft die aan;

er zijn te weinig parameters. Het verwachte aantal is 1.

Idee?
 
Had ik inderdaad ook gezien ;)
Je moet nog een kleine aanpassing maken in de init query:
Code: 
strSQL = "SELECT [initials],[password],[access_level],[password_date] FROM tbl_users " _
    & "WHERE initials=[B][COLOR="red"]'[/COLOR][/B]" & Forms!Frm_Login!Initials [B][COLOR="red"]& "'"[/COLOR][/B]
 
Hahaha,

volgende foutmelding; Ongeldig gebruik van Null

Sorry als ik je heel erg lastig val hoor! Ben al super blij dat je me uberhaupt helpt!
 
In je versie die je hebt gepost ontbreken nogal wat datums in het veld [Password_date]. Die moet je ook nog vullen ;)
 
mag ik dan nog even snel wat vragen voor ik dit topic sluit?

Als ik nu die initialen ook vermeld wil hebben in de tabel patient, dus al AJ in logt dan moeten zijn initialen er bij komen en als SvW inlogt moeten die initialen er achter komen te staan.

Is dat heel simpel te doen?

Groetjes,

Simone
 
Of het simpel is, hangt een beetje af van hoe en wanneer je de tabel vult. Je moet op de een of andere manier de initialen meegeven naar de formulieren die worden geopend. Dat zou kunnen met een OpenArgs variabele, die elk formulier kent. Als je op alle formulieren een tekstveld txtUserID maakt, en dat steeds vult met de userID, dan kun je dat wel opslaan in de tabel lijkt mij.
Overigens zou ik zelf met één hoofdformulier werken, waarbij je jet veld [Access_level] gebruikt om knoppen zichtbaar of onzichtbaar te maken. Op die manier hou je de formulieren een stuk overzichtlijker, en makkelijker te onderhouden. Maar da's een zijsprongetje... Ook weer niet helemaal natuurlijk, want als je parameters gaat doorgeven aan andere formulieren, wil je er zo weinig mogelijk hoeven te verbouwen. Niet?
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan