Solved

MS Access restrict user access to a form

Posted on 2014-01-03
10
1,319 Views
Last Modified: 2014-01-06
Hello,

I have a user table which holds users name, unique Id and other details.

I have a main form accessible to all. On this form I would like to add a button which gives access only to the users from the UserTable.

I have a function which retrieves the user ID from the system as the users will use the database from their personnal PC. I'd like to compare this id with the ids from my list and open the form if the id matches else provide a popo message saying the access is restricted.

Thanks for your help on this!
0
Comment
Question by:dnt2009
  • 4
  • 3
  • 2
  • +1
10 Comments
 
LVL 10

Assisted Solution

by:etech0
etech0 earned 225 total points
ID: 39753991
without too much info, I threw something together. try this:

userid = functionThatProvidesUserID()
if dcount("fieldcontainingID","usertable","fieldcontainingID="&userid)=1 then
    msgbox("restricted")
    exit sub
end if
docmd.openform("formname")
  

Open in new window

0
 
LVL 47

Accepted Solution

by:
Dale Fye (Access MVP) earned 275 total points
ID: 39754012
No points please.

Actually, I would use the main forms Load event to enable/disable that button, so that the button is not even enabled (or maybe even visible) if the user that is currently logged in does not have access to that feature.

The code would be similar to what etech0 posted:
Private Sub Form_Load

    Dim strUserID as string
    Dim strCriteria as string

    strUserId = functionThatProvidesUserID()
    strCriteria =  "fieldcontainingID='" & strUserId & "'"
    me.YourButtonName.Enabled = dcount("fieldcontainingID","usertable",strCriteria)=1

End Sub

Open in new window

0
 

Author Comment

by:dnt2009
ID: 39754127
Hi both,

Thank you for your feedback.

I get an error message and the line with the dcount function is highlighted. Am I to keep the " " quotes even after replacing by my real data?

dcount("userID","tblUsers","userID="&userid)=1 or

dcount(userID",tblUsers","userID="&userid)=1


strCriteria =  "userID='" & strUserId & "'" or

me.GotoSection.Enabled = dcount("userID","tblusers",strCriteria)=1 or

me.GotoSection.Enabled = dcount(userID,tblusers,strCriteria)=1.

I've tried both and I still get the error message.

Thanks
0
 
LVL 10

Expert Comment

by:etech0
ID: 39754145
What error are you getting?

For Dcount, keep the first version. for me.gotosection also keep the first version.

Try changing this line as follows:

strCriteria =  "userID=" & strUserId

(the other method is for if ID would be a string, but i"m assuming that it's integer
0
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
ID: 39754156
What error are you getting?

Well, the UserID will be a string, so you must wrap that in quotes (I used single quotes) for your strCriteria.  The syntax for the DCOUNT should be:

dCount("SomeFieldName", "tblUsers", strCriteria)

You must include the field name and table name in quotes, and because the UserID will be a string, it will have to be in quotes.  strCriteria should look something like:

userID = 'fyed'

if you did a debug.print in the immediate window prior to executing the DCOUNT( ) function.  Try this:

strCriteria =  "userID='" & strUserId & "'"
debug.print strCriteria
me.GotoSection.Enabled = dcount("userID","tblusers",strCriteria)=1
0
Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

 
LVL 10

Expert Comment

by:etech0
ID: 39754160
How do you know that the userid is a string?
0
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
ID: 39754174
from the OP's original post:

"I have a function which retrieves the user ID from the system"

Only system UserID I'm familiar with is the one retrieved by either ENVIRON("Username") or by the Windows API, both of which return the windows login userid.
0
 
LVL 10

Expert Comment

by:etech0
ID: 39754182
Right. IT  could be, though, that he has a function that refers to environ("username"), and looks up the corresponding ID. I have a function like that in my db.

Why don't we ask the OP...

Question: What data type does your function that retrieves the user ID return? Is it a string, or an integer?

You can check this by pasting the function into the immediate window, pressing enter, and seeing if the result is in quotes or not.
0
 
LVL 26

Expert Comment

by:Nick67
ID: 39755370
Here is the codeblock from Dev Ashish from the AccessWeb
Option Compare Database
Option Explicit

Private Type USER_INFO_2
    usri2_name As Long
    usri2_password  As Long  ' Null, only settable
    usri2_password_age  As Long
    usri2_priv  As Long
    usri2_home_dir  As Long
    usri2_comment  As Long
    usri2_flags  As Long
    usri2_script_path  As Long
    usri2_auth_flags  As Long
    usri2_full_name As Long
    usri2_usr_comment  As Long
    usri2_parms  As Long
    usri2_workstations  As Long
    usri2_last_logon  As Long
    usri2_last_logoff  As Long
    usri2_acct_expires  As Long
    usri2_max_storage  As Long
    usri2_units_per_week  As Long
    usri2_logon_hours  As Long
    usri2_bad_pw_count  As Long
    usri2_num_logons  As Long
    usri2_logon_server  As Long
    usri2_country_code  As Long
    usri2_code_page  As Long
End Type

Public Declare Function GetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long


Private Declare Function GetComputerName Lib "kernel32" _
Alias "GetComputerNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long

 
Private Declare Function apiNetGetDCName _
    Lib "netapi32.dll" Alias "NetGetDCName" _
    (ByVal servername As Long, _
    ByVal DomainName As Long, _
    bufptr As Long) As Long
 
' function frees the memory that the NetApiBufferAllocate
' function allocates.
Private Declare Function apiNetAPIBufferFree _
    Lib "netapi32.dll" Alias "NetApiBufferFree" _
    (ByVal buffer As Long) _
    As Long
 
' Retrieves the length of the specified wide string.
Private Declare Function apilstrlenW _
    Lib "kernel32" Alias "lstrlenW" _
    (ByVal lpString As Long) _
    As Long
 
Private Declare Function apiNetUserGetInfo _
    Lib "netapi32.dll" Alias "NetUserGetInfo" _
    (servername As Any, _
    username As Any, _
    ByVal Level As Long, _
    bufptr As Long) As Long
 
' moves memory either forward or backward, aligned or unaligned,
' in 4-byte blocks, followed by any remaining bytes
Private Declare Sub sapiCopyMem _
    Lib "kernel32" Alias "RtlMoveMemory" _
    (Destination As Any, _
    Source As Any, _
    ByVal Length As Long)
 
Private Declare Function apiGetUserName Lib _
    "advapi32.dll" Alias "GetUserNameA" _
    (ByVal lpBuffer As String, _
    nSize As Long) _
    As Long
 
Private Const MAXCOMMENTSZ = 256
Private Const NERR_SUCCESS = 0
Private Const ERROR_MORE_DATA = 234&
Private Const MAX_CHUNK = 25
Private Const ERROR_SUCCESS = 0&


'******** Code Start ********
'This code was originally written by Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
 
Function fGetFullNameOfLoggedUser(Optional strUserName As String) As String
'
' Returns the full name for a given UserID
'   NT/2000 only
' Omitting the strUserName argument will try and
' retrieve the full name for the currently logged on user
'
On Error GoTo ErrHandler
Dim pBuf As Long
Dim dwRec As Long
Dim pTmp As USER_INFO_2
Dim abytPDCName() As Byte
Dim abytUserName() As Byte
Dim lngRet As Long
Dim i As Long
 
    ' Unicode
    abytPDCName = fGetDCName() & vbNullChar
    If (Len(strUserName) = 0) Then strUserName = fGetUserName()
    abytUserName = strUserName & vbNullChar
 
    ' Level 2
    lngRet = apiNetUserGetInfo( _
                            abytPDCName(0), _
                            abytUserName(0), _
                            2, _
                            pBuf)
    If (lngRet = ERROR_SUCCESS) Then
        Call sapiCopyMem(pTmp, ByVal pBuf, Len(pTmp))
        fGetFullNameOfLoggedUser = fStrFromPtrW(pTmp.usri2_full_name)
    End If
 
    Call apiNetAPIBufferFree(pBuf)
ExitHere:
    Exit Function
ErrHandler:
    fGetFullNameOfLoggedUser = vbNullString
    Resume ExitHere
End Function
 
Private Function fGetUserName() As String
' Returns the network login name
Dim lngLen As Long, lngRet As Long
Dim strUserName As String
    strUserName = String$(254, 0)
    lngLen = 255
    lngRet = apiGetUserName(strUserName, lngLen)
    If lngRet Then
        fGetUserName = Left$(strUserName, lngLen - 1)
    End If
End Function
 
Function fGetDCName() As String
Dim pTmp As Long
Dim lngRet As Long
Dim abytBuf() As Byte
 
    lngRet = apiNetGetDCName(0, 0, pTmp)
    If lngRet = NERR_SUCCESS Then
        fGetDCName = fStrFromPtrW(pTmp)
    End If
    Call apiNetAPIBufferFree(pTmp)
End Function
 
Private Function fStrFromPtrW(pBuf As Long) As String
Dim lngLen As Long
Dim abytBuf() As Byte
 
    ' Get the length of the string at the memory location
    lngLen = apilstrlenW(pBuf) * 2
    ' if it's not a ZLS
    If lngLen Then
        ReDim abytBuf(lngLen)
        ' then copy the memory contents
        ' into a temp buffer
        Call sapiCopyMem( _
                abytBuf(0), _
                ByVal pBuf, _
                lngLen)
        ' return the buffer
        fStrFromPtrW = abytBuf
    End If
End Function


Function ReturnUserName() As String
' returns the NT Domain User Name
Dim rString As String * 255, sLen As Long, tString As String
    tString = ""
    On Error Resume Next
    sLen = GetUserName(rString, 255)
    sLen = InStr(1, rString, Chr(0))
    If sLen > 0 Then
        tString = Left(rString, sLen - 1)
    Else
        tString = rString
    End If
    On Error GoTo 0
    ReturnUserName = UCase(Trim(tString))
End Function

 
Function ReturnComputerName() As String
    Dim rString As String * 255, sLen As Long, tString As String
    tString = ""
    On Error Resume Next
    sLen = GetComputerName(rString, 255)
    sLen = InStr(1, rString, Chr(0))
    If sLen > 0 Then
        tString = Left(rString, sLen - 1)
    Else
        tString = rString
    End If
    On Error GoTo 0
    ReturnComputerName = UCase(Trim(tString))
End Function

Open in new window


Many good and happy things can then be done with ReturnUserName and ReturnComputerName
0
 

Author Comment

by:dnt2009
ID: 39758619
Hi all - many thasnks for your feedback.
UserID is string. So I've had the quotes and did a mix of etech0 and fyed's codes to have the button visible for the users in the table.

I will slips point between the both of you.

Hi Nick67 - Thanks for the code. Although I don't require it for this particular issue, I will keep it in mine for future use maybe.

Thanks all for your help.
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

When you are entering numbers in a speadsheet, and don't remember what 6×7 is, you just type “=6*7" instead. It works in every cell! This is not so in Access. To enter the elusive 42 in a text box, you have to find a calculator, and then copy the re…
Overview: This article:       (a) explains one principle method to cross-reference invoice items in Quickbooks®       (b) explores the reasons one might need to cross-reference invoice items       (c) provides a sample process for creating a M…
Familiarize people with the process of utilizing SQL Server stored procedures from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Micr…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

762 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

20 Experts available now in Live!

Get 1:1 Help Now