Solved

Multiple field validation

Posted on 2004-04-01
12
289 Views
Last Modified: 2008-02-01
I used the below code which I received from another answer here to check that a UserID present in a my database and that works fine.

             If IsNull(DLookup("StudentNumber", "tblSecurity", "[StudentNumber]=" & Me.txtUserID & "")) Then

I need to know how to adapt this to check that both the password and the userid match, and also I want to be able to retrieve a value from another field in the table (accesslevel - numeric value).

Probably not too hard but i'm setting the points a bit higher because it's quite urgent.

Thanks for your help


Arron
0
Comment
Question by:arron_cooper
  • 6
  • 3
  • 2
  • +1
12 Comments
 
LVL 32

Expert Comment

by:jadedata
ID: 10733348
Greetings arron_cooper!

  You could be better off using a recordset to do more than one field

  dim rs as dao.recordset
  set rs = currentdb.openrecordset("SELECT * from TABLENAME WHERE ([UserName]='" &  currentuser &  "') and([UserPW]='" & SomeWord & "');", dbopensnapshot)
  if (rs.bof and rs.eof) then
    'entry not found
  else
   intAccessLevel = rs("AccessLevel")
  endif


or you can use the dlookup...
IsNull(DLookup("AccessLevel", "tblSecurity", "([UserName]='" &  currentuser &  "') and([UserPW]='" & SomeWord & "')))

regards
jack
0
 
LVL 54

Accepted Solution

by:
nico5038 earned 250 total points
ID: 10733524
I use in a similar situation just a combobox with all users and the password hidden in the first column.

Thus the userid will always be present and after typing the password a simple:

IF me.txtPassword = me.combobox then
    ' OK
else
    ' error message
endif

Nic;o)
0
 
LVL 39

Expert Comment

by:stevbe
ID: 10733773
does each user have their own login for the computer? If so you could grab their username from the system and go directly to what they need instead of having them enter a username and password.

put this in the declaration section ...
    Private Declare Function GetUserNameAPI Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

add this to function
'------------------------------------------------------------------------------
Public Function GetUserName() As String
'------------------------------------------------------------------------------
'   variables
    Dim strUser As String
    Dim lngLen As Long
    Dim lngRet As Long
'------------------------------------------------------------------------------
   
        'build return parameters
        strUser = String$(255, vbNullChar)
        lngLen = 255
       
        'call api
        lngRet = GetUserNameAPI(strUser, lngLen)
       
        If lngRet = 0 Then
            'return of 0 indicates failure
            strUser = vbNullString
        Else
            'non-zero return indicates success, strip trailing null character
            strUser = Left$(strUser, lngLen - 1)
        End If
           
        'assign return value to private var
        GetUserName = strUser

End Function
'------------------------------------------------------------------------------

and then call GetUserName to find oput who is logged on.

Steve
0
 
LVL 54

Expert Comment

by:nico5038
ID: 10733798
Nice function Steve, but I normally use:

environ("username")

Nic;o)
0
 
LVL 39

Expert Comment

by:stevbe
ID: 10734036
I have had environ("username") not exist on PCs which causes a crash so I never use it. Environ variables are also easily spoofed.

What I really use is a little longer, I store the username in a private variable in my basState module which also contains the GetUserName function and I only call the api when necessary. I use the user name to log last editor on all updates and also in my central error handler, GetAppName is also logged by the central error handler which writes to a common mdb for all my apps. I usually set 2 levels of UI permissions for menu availablility by calling IsAdmin in my menu functions. In these particular functions I don't have error handling because if these functions fail then I did a really bad job and deserve to get a help desk ticket because the app should never have been released :-)

Steve

'------------------------------------------------------------------------------
'
'   Copyright © 2003-2004 My Company's name
'   My Company's Address
'   All rights reserved.
'
'------------------------------------------------------------------------------
'
'   Module:     basState
'
'   Notes:      Get/Set Application State.
'
'------------------------------------------------------------------------------
'   Environment
    Option Compare Database
    Option Explicit
    Option Base 0
'------------------------------------------------------------------------------
'   Module Declares
    Private Declare Function GetUserNameAPI Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
'------------------------------------------------------------------------------
'   Module Variables
    Private mstrUserName As String
    Private mstrAppName As String
    Private mblnIsAdmin As Boolean
'------------------------------------------------------------------------------
'
'   Method: GetUserName
'
'   Notes:  Get the logged on username.
'
'------------------------------------------------------------------------------
Public Function GetUserName() As String
'------------------------------------------------------------------------------
'   variables
    Dim strUser As String
    Dim lngLen As Long
    Dim lngRet As Long
'------------------------------------------------------------------------------
   
    'only do this if we have to
    If Len(mstrUserName) = 0 Then
   
        'build return parameters
        strUser = String$(255, vbNullChar)
        lngLen = 255
       
        'call api
        lngRet = GetUserNameAPI(strUser, lngLen)
       
        If lngRet = 0 Then
            'return of 0 indicates failure
            strUser = vbNullString
        Else
            'non-zero return indicates success, strip trailing null character
            strUser = Left$(strUser, lngLen - 1)
        End If
           
        'assign return value to private var
        mstrUserName = strUser
    End If
   
    'assign return value
    GetUserName = mstrUserName
   
'------------------------------------------------------------------------------
End Function
'------------------------------------------------------------------------------
'
'   Method: GetAppName
'
'   Notes:  Get the this application's name.
'
'------------------------------------------------------------------------------
Public Function GetAppName() As String
'------------------------------------------------------------------------------

    'only do this if we have to
    If Len(mstrAppName) = 0 Then
        'assign return value to private var
        mstrAppName = CurrentDb.Properties("AppTitle").Value
    End If
   
    'assign return value
    GetAppName = mstrAppName
   
'------------------------------------------------------------------------------
End Function
'------------------------------------------------------------------------------
'
'   Method: IsAdmin
'
'   Notes:  Determine if the loggedon user is an Administrator.
'
'------------------------------------------------------------------------------
Public Function IsAdmin() As Boolean

    'only do this if we have to
    If Len(mstrUserName) = 0 Then
        mblnIsAdmin = Not IsNull(DLookup("Admin", "tblAdmin", "Admin='" & GetUserName & "'"))
    End If
   
    IsAdmin = mblnIsAdmin
   
End Function
'------------------------------------------------------------------------------
0
 
LVL 39

Expert Comment

by:stevbe
ID: 10734089
quick example of writing to a memo field (thanks jadedata)

'-------------------------------------------------------------------------------
'
'   Method: txtChgDesc_AfterUpdate
'
'   Notes:  Update record Description, Editdate, EditUser fields.
'
'-------------------------------------------------------------------------------
'   Revision History:
'   Date:       Developer:      Description:
'-------------------------------------------------------------------------------
'   01/21/2004  Stevbe        Initial Release
'-------------------------------------------------------------------------------
Private Sub txtChgDesc_AfterUpdate()
'-------------------------------------------------------------------------------
'   enable custom error handling
    On Error GoTo ERR_txtChgDesc_AfterUpdate
'-------------------------------------------------------------------------------

    'update the description
    Me!ChgDesc = Me.txtChgDesc.Value & vbNullString
   
    'set the record edit date and user fields
    Me!EditDate = Now()
    Me!EditUser = GetUserName

'-------------------------------------------------------------------------------
EXIT_txtChgDesc_AfterUpdate:
    Exit Sub
'-------------------------------------------------------------------------------
ERR_txtChgDesc_AfterUpdate:
    Select Case Err.Number
        Case Else
            LogError ErrLogMod:="Form_frmChgDesc", _
                     ErrLogProc:="txtChgDesc_AfterUpdate", _
                     ErrLogNo:=Err.Number, _
                     ErrLogDesc:=Err.Description, _
                     ErrLogDisp:=True
    End Select
    Resume EXIT_txtChgDesc_AfterUpdate
'-------------------------------------------------------------------------------
End Sub
'-------------------------------------------------------------------------------
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 39

Expert Comment

by:stevbe
ID: 10734096
and now for the error handler ...

'------------------------------------------------------------------------------
'
'   Copyright © 2003-2004 My Company's name
'   My Company's Address
'   All rights reserved.
'
'------------------------------------------------------------------------------
'
'   Module:     basError
'
'   Notes:      Centralized error handler.
'
'-------------------------------------------------------------------------------
'   Environment
    Option Compare Database
    Option Explicit
    Option Base 0
'-------------------------------------------------------------------------------
'
'   Method: LogError
'
'   Notes:  Generic error handler called by all methods in the application.
'
'-------------------------------------------------------------------------------
Public Sub LogError(ByRef ErrLogMod As String, _
                    ByRef ErrLogProc As String, _
                    ByRef ErrLogNo As Long, _
                    ByRef ErrLogDesc As String, _
                    ByRef ErrLogDisp As Boolean)
'-------------------------------------------------------------------------------
'   variables
    Dim cmd As ADODB.Command
    Dim prm As ADODB.Parameter
'-------------------------------------------------------------------------------
'   enable custom error handling
'   because this is an error handler we need to clear the error state first
    Err.Clear
    On Error GoTo ERR_LogError
'-------------------------------------------------------------------------------
'   make sure input arguments are clean
    ErrLogMod = Trim$(ErrLogMod)
    ErrLogProc = Trim$(ErrLogProc)
    ErrLogDesc = Trim$(Left$(ErrLogDesc, 255))
'-------------------------------------------------------------------------------
   
    'get the stored proc (query) to append to error log
    Set cmd = New ADODB.Command
    cmd.CommandType = adCmdStoredProc
    cmd.CommandText = "qappErrLog"
    cmd.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= Z:\ERR.mdb;User Id=admin;Password="
   
    'set the app name
    Set prm = cmd.CreateParameter(Name:="ErrLogApp", _
                                  Type:=adChar, _
                                  Direction:=adParamInput, _
                                  Size:=Len(GetAppName), _
                                  Value:=GetAppName)
    cmd.Parameters.Append prm
   
    'set the module name
    Set prm = cmd.CreateParameter(Name:="ErrLogMod", _
                                  Type:=adChar, _
                                  Direction:=adParamInput, _
                                  Size:=Len(ErrLogMod), _
                                  Value:=ErrLogMod)
    cmd.Parameters.Append prm
   
    'set the procedure name
    Set prm = cmd.CreateParameter(Name:="ErrLogProc", _
                                  Type:=adChar, _
                                  Direction:=adParamInput, _
                                  Size:=Len(ErrLogProc), _
                                  Value:=ErrLogProc)
    cmd.Parameters.Append prm
   
    'set the error number
    Set prm = cmd.CreateParameter(Name:="ErrLogNo", _
                                  Type:=adInteger, _
                                  Direction:=adParamInput, _
                                  Value:=ErrLogNo)
    cmd.Parameters.Append prm
   
    'set the description
    Set prm = cmd.CreateParameter(Name:="ErrLogDesc", _
                                  Type:=adChar, _
                                  Direction:=adParamInput, _
                                  Size:=Len(ErrLogDesc), _
                                  Value:=ErrLogDesc)
    cmd.Parameters.Append prm
   
    'set the user
    Set prm = cmd.CreateParameter(Name:="ErrLogUser", _
                                  Type:=adChar, _
                                  Direction:=adParamInput, _
                                  Size:=Len(GetUserName), _
                                  Value:=GetUserName)
    cmd.Parameters.Append prm
       
    'add the error details to the log
    cmd.Execute , , adExecuteNoRecords

    'displayed to user
    If ErrLogDisp = True Then
        MsgBox Prompt:=ErrLogMod & "." & ErrLogProc & vbCrLf & ErrLogDesc, _
               Buttons:=vbOKOnly + vbCritical, _
               Title:="Unexpected Error"
    End If
   
'-------------------------------------------------------------------------------
EXIT_LogError:
    On Error Resume Next
    'cleanup
    Set prm = Nothing
    Set cmd = Nothing
    Exit Sub
'-------------------------------------------------------------------------------
ERR_LogError:
    MsgBox Prompt:=Err.Number & ": " & Err.Description, _
           Buttons:=vbOKOnly + vbCritical, _
           Title:="Unexpected Error"
    Resume EXIT_LogError
'-------------------------------------------------------------------------------
End Sub
'-------------------------------------------------------------------------------
0
 
LVL 39

Expert Comment

by:stevbe
ID: 10734192
so how do I control menus ... why in my splash form's open event ...

    'see if the logged on user is an administrator
    With Application.CommandBars("BJs Menu Bar")
        .Controls.Item("Administration").CommandBar.Enabled = IsAdmin
    End With

in some cases I disable individual controls

    'see if the logged on user is an administrator
    With Application.CommandBars("BJs Menu Bar")
        .Controls.Item("Employee Master").CommandBar.Enabled = IsAdmin
        .Controls.Item("Administrator Master").CommandBar.Enabled = IsAdmin
    End With

in some I only change the read/write permissions on the form itself from the Open event
    'see if the logged on user is an administrator
    If IsAdmin Then
        Me.RecordsetType = 0 'dynamic, read write
    Else
        Me.RecordsetType = 2 'snapshot, read only
    End If
   
0
 

Author Comment

by:arron_cooper
ID: 10734935
Na the users all load the database from a shared desktop, so there aren't lots of separate users defined in the windows login.  I tried the SQL statement but that doesnt seem to be working.  I've tried something like that before and one of the things I noticed is that "as currentdb" doesn't seem to be an option.  There's as currentproject and currentdata, but they don't use '.' after them.  I'm probably being very stupid and missing something here though.  Thanks for all the feedback so far.
0
 
LVL 54

Expert Comment

by:nico5038
ID: 10735183
Isn't the combo with hidden password an option ?

Nic;o)
0
 
LVL 39

Expert Comment

by:stevbe
ID: 10737237
You could use the code jadedata supplied if you add the reference to Microsoft DAO Object Library to your application.

Steve
0
 

Author Comment

by:arron_cooper
ID: 10739712
Thanks for all the help, and the vast amount of code, should definately help me along the way.  Went with nico's solution because I couldn't get my dao to work even with Microsoft DAO Object library 3.6 selected.  Ty

Arron
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Suggested Solutions

In Debugging – Part 1, you learned the basics of the debugging process. You learned how to avoid bugs, as well as how to utilize the Immediate window in the debugging process. This article takes things to the next level by showing you how you can us…
A simple tool to export all objects of two Access files as text and compare it with Meld, a free diff tool.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Basics of query design. Shows you how to construct a simple query by adding tables, perform joins, defining output columns, perform sorting, and apply criteria.

744 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now