Results 1 to 3 of 3
  1. #1
    Join Date
    Apr 2009
    Posts
    4

    Exclamation Unanswered: Difficulties with Login Info for Individual User

    I want to prepare a database where there will be two types of user.

    1. Administrator
    2. Guest

    Rule:

    1. Admin. Administrator will be given the power to change/add records/all power as admin.

    2. Guest. Guest will be given power to see the records/queries only.

    How to prepare this kind of form..

    NB: Im novice in MS Access.

  2. #2
    Join Date
    Nov 2007
    Location
    Adelaide, South Australia
    Posts
    4,049
    Have you tried searching for this, I am sure it has been answered recently.... several times.

    I believe there is something about GetUser() in the CodeBank. Please, check it out, it's a very nice solution for when the windows user login is sufficient.
    Owner and Manager of
    CypherBYTE, Microsoft Access Development Specialists.
    Microsoft Access MCP.
    And all around nice guy!


    "Heck it's something understood by accountants ... so it can't be 'that' difficult..." -- Healdem
    "...teach a man to code and he'll be frustrated for life! " -- georgev

  3. #3
    Join Date
    Mar 2009
    Posts
    5,441
    Provided Answers: 14
    He is an example that controls the user's rights on a form. You can adapt it to restrict access to other objects. User here is the Windows user, not a user defined through Access security. I join a sample database using this system.
    Code:
    Option Compare Database
    Option Explicit
    
    Public Const PRIV_NONE = 0
    Public Const PRIV_READ = 1
    Public Const PRIV_EDIT = 2
    Public Const PRIV_ADD = 4
    Public Const PRIV_DELETE = 8
    Public Const PRIV_FILTER = 16
    Public Const PRIV_DESIGN = 32
    Public Const PRIV_DATASHEET = 64
    Public Const PRIV_PIVOTCHART = 128
    Public Const PRIV_PIVOTTABLE = 255
    Public Const PRIV_ALL = 65535
    
    Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
    
    Function GetNTUser() As String
    '
    ' Retrieve the ID of the current user
    ' (Windows user not Access user)
    '
        On Error GoTo Err_GetNTUser
        
        Dim strUserName As String
        Dim lngUserNameSize As Long
        Dim lngApiResult As Long
        
        strUserName = String$(255, 0)
        lngUserNameSize = Len(strUserName)
        lngApiResult = GetUserName(strUserName, lngUserNameSize)
        strUserName = Left$(strUserName, lngUserNameSize - 1)
        strUserName = NormalizeUserName(strUserName)
        GetNTUser = strUserName
        
    Exit_GetNTUser:
        Exit Function
        
    Err_GetNTUser:
        MsgBox Err.Description
        Resume Exit_GetNTUser
        
    End Function
    
    Function GetUserPrivilege() As Long
    
        On Error GoTo Err_GetUserPrivilege:
        
        Dim strCriteria As String
            
        strCriteria = "UserID = '" & GetNTUser & "'"
        GetUserPrivilege = Nz(DLookup("UserPrivilege", "UserPrivileges", strCriteria), PRIV_NONE)
        
    Exit_GetUserPrivilege:
        Exit Function
        
    Err_GetUserPrivilege:
        MsgBox Err.Description
        Resume Exit_GetUserPrivilege
    
    End Function
    Function NormalizeUserName(UserID As String) As String
    '
    ' Remove most current diacritics from user names
    '
        On Error GoTo Err_NormalizeUserName
    
        Dim strRetVal As String
        
        strRetVal = LCase(UserID)
        strRetVal = Replace(strRetVal, "", "e")
        strRetVal = Replace(strRetVal, "", "e")
        strRetVal = Replace(strRetVal, "", "e")
        strRetVal = Replace(strRetVal, "", "c")
        strRetVal = Replace(strRetVal, "", "a")
            
    Exit_NormalizeUserName:
        NormalizeUserName = strRetVal
        Exit Function
    
    Err_NormalizeUserName:
        strRetVal = ""
        MsgBox Err.Description
        Resume Exit_NormalizeUserName
        
    End Function
    
    Private Sub Form_Open(Cancel As Integer)
    
        Dim lngUserPrivilege As Long
        
        lngUserPrivilege = GetUserPrivilege
        If lngUserPrivilege = PRIV_NONE Then
            MsgBox "You are not allowed to use this application.", vbCritical, "Access denied!"
            Application.Quit
        ElseIf lngUserPrivilege = PRIV_READ Then
            Me.AllowEdits = False
            Me.AllowAdditions = False
            Me.AllowDeletions = False
        Else
            If lngUserPrivilege And PRIV_EDIT Then
                Me.AllowEdits = True
            End If
            If lngUserPrivilege And PRIV_ADD Then
                Me.AllowAdditions = True
            End If
            If lngUserPrivilege And PRIV_DELETE Then
                Me.AllowDeletions = True
            End If
            If lngUserPrivilege And PRIV_FILTER Then
                Me.AllowFilters = True
            End If
            If lngUserPrivilege And PRIV_DESIGN Then
                Me.AllowDesignChanges = True
            End If
            If lngUserPrivilege And PRIV_DATASHEET Then
                Me.AllowDatasheetView = True
            End If
            If lngUserPrivilege And PRIV_PIVOTCHART Then
                Me.AllowPivotChartView = True
            End If
            If lngUserPrivilege And PRIV_PIVOTTABLE Then
                Me.AllowPivotTableView = True
            End If
        End If
        
    End Sub
    Have a nice day!
    Attached Files Attached Files

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •