Microsoft Access ADP Project

[primagic]

I have created an Microsoft Access ADP project linked to an SQL Server. I usually use the following code for a login screen in a normal mdb file, however the code is not working in an adp file

Sub display_menu()
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

ValidUser = 2

' **********************************************
' validate UserID
' **********************************************
CheckUser = DCount("[UserID]", "Users", "UserID=[Forms]![frmLogin]![UserID]")
    If CheckUser = 1 Then
        ValidUser = 2
    Else
        ValidUser = 0
   End If
    
' **********************************************
' validate password
' **********************************************
If ValidUser = 2 Then
   CheckPassword = DLookup("[Password]", "Users", "UserID=forms!frmLogin!UserID")
   If UCase(CheckPassword) = UCase(Forms!frmLogin!Password) Then
        ValidUser = 2
   Else
        ValidUser = 1
   End If
   
End If

' **********************************************
' validate AccessLevel
' **********************************************
If ValidUser = 2 Then
    AccessLevel = DLookup("[AccessLevel]", "Users", "UserID=forms!frmLogin!UserID")
End If

Select Case ValidUser

    Case 0, 1
            strmsg = " Access Denied" & _
                        vbCrLf & " Contact your Administrator if the problem persists.   "
            MsgBox strmsg, vbInformation, "Invalid UserID or Password"
            
           ' DoCmd.Quit
        
    Case 2
            Select Case AccessLevel
               Case 1 ' level1 menu
                    ' validate password expiry
                      PasswordPeriod = DLookup("[PasswordDate]", "Users", "UserID = forms!frmLogin!UserID")
                      If PasswordPeriod < Date - 30 Then
                            Dim stLinkCriteria As String
                            stLinkCriteria = "[UserID]=" & Forms!frmLogin!UserID
                            strmsg = " Your password has expired. You must change your password"
                            MsgBox strmsg, vbInformation, "Expired Password"
                            
                            
                            DoCmd.OpenForm "frmChangePassword", acNormal, , stLinkCriteria
                        Else
                            DoCmd.OpenForm "frmMainMenu"
                            Forms!frmMainMenu!CurrentUser = Forms!frmLogin!UserID
                            DoCmd.Close acForm, "frmLogin"
                        End If
                                                              
               Case 2 ' level2 menu
                    ' validate password expiry
                      PasswordPeriod = DLookup("[PasswordDate]", "Users", "UserID = forms!frmLogin!UserID")
                      If PasswordPeriod < Date - 30 Then
                            strmsg = " Your password has expired. You must change your password"
                            MsgBox strmsg, vbInformation, "Expired Password"
                            DoCmd.OpenForm "frmChangePassword", acNormal
                        Else
                            DoCmd.OpenForm "frmMainMenu"
                            Forms!frmMainMenu!CurrentUser = Forms!frmLogin!UserID
                            DoCmd.Close acForm, "frmLogin"
                        End If
                                                                                
                 Case 3 ' level3 menu
                    ' validate password expiry
                      PasswordPeriod = DLookup("[PasswordDate]", "Users", "UserID = forms!frmLogin!UserID")
                      If PasswordPeriod < Date - 30 Then
                            strmsg = " Your password has expired. You must change your password"
                            MsgBox strmsg, vbInformation, "Expired Password"
                            DoCmd.OpenForm "frmChangePassword", acNormal
                        Else
                            
                            DoCmd.OpenForm "frmMainMenu"
                            Forms!frmMainMenu!CurrentUser = Forms!frmLogin!UserID
                            DoCmd.Close acForm, "frmLogin"
                        End If
                Case Else
                        strmsg = " Access Denied" & _
                                    vbCrLf & " Contact your Administrator if the problem persists.   "
                        MsgBox strmsg, vbInformation, "InvalidUserID or Password"
            End Select

End Select

exit_display_menu:
    Exit Sub
    
err_display_menu:
    MsgBox Err.decsription
    Resume exit_display_menu

End Sub

I am getting an incorrect syntax error near '!'. It stops on the first line

CheckUser = DCount("[UserID]", "Users", "UserID=[Forms]![frmLogin]![UserID]")

 

[PHV]

What about this ?

CheckUser = DCount("[UserID]", "Users", "UserID='" & Forms!frmLogin!UserID & "'")

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[primagic]

Cool thanks. I will give it a try.

Another question, do you know how to make the sql server login prompt dissappear when you open the access project? or how to automate it

 

[sparkbyte]

Another question, do you know how to make the sql server login prompt dissappear when you open the access project? or how to automate it

Set the security on your DB so that it uses the users AD account (Windows authentication). What I did was created an AD Global Security Group and added the users to that group then on the SQL server assigned the rights to the DB using the AD group. There are MANY ways to restrict usage to the DB so you will want to RTFM SQL security management to at least get a rudimentary understanding of SQL server's security model.

Here are a couple of links to a couple from a quick google.

http://sqlserverpedia.com/wiki/Database_Security_Tutorial#Fixed_Roles

http://www.developer.com/db/article.php/721441/Microsoft-SQL-Servers-Security-Model.htm

Hope this helps.

Thanks

John Fuhrman