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

    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


    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
    Adelaide, South Australia
    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
    Provided Answers: 15
    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.
    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 Function
        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 Function
        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")
        NormalizeUserName = strRetVal
        Exit Function
        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!"
        ElseIf lngUserPrivilege = PRIV_READ Then
            Me.AllowEdits = False
            Me.AllowAdditions = False
            Me.AllowDeletions = False
            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