Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Determine which permissions group a user belongs to

Status
Not open for further replies.

jsolutions

Programmer
Jul 18, 2002
157
US
I have an access 2000 database that has been in use for quite a while with security groups and users using Workgroup Security. Everything works fine. Now, the customer has required a "Read Only" group which I have created. In testing, I am coming across some issues where forms go to the "new" record on opening. Obviously, this is triggering because of the "read only" permissions. I know how to access the current user of the system, but is there a way to determine (through code) the user group a user belongs to so that I can set up an if...then to avoid this error.

Thanks
 
Try this:

Dim bolMemberOfGroup as Boolean

bolMemberOfGroup = UserBelongsToGroupDB("NameOfYourGroup")

Code:
Option Compare Database
Option Explicit

Function UserBelongsToGroupDB(strGroupName As String, _
                     Optional varUserName As Variant, _
                     Optional varDbName As Variant) As Boolean
                         
    Dim rst As New ADODB.Recordset
    Dim bolMOG As Boolean
    Dim strSQL As String
    Dim strUserName As String
    Dim strDbName As String
    
    On Error GoTo ErrHandler
    
    If (IsMissing(varUserName)) Then strUserName = CurrentUser Else strUserName = varUserName
    If (IsMissing(varDbName)) Then strDbName = SysCmd(acSysCmdGetWorkgroupFile) Else strDbName = varDbName
    
'****************************************************************************************************************************************
'*  user is trying to determine if the user's name and SID of currentdatabase is equal to the user's name and SID of strDBName     *
'****************************************************************************************************************************************

    If (strDbName = SysCmd(acSysCmdGetWorkgroupFile)) Then
        strSQL = "SELECT Count(*) AS IsMemberOfGroup FROM (MSysAccounts AS MSA INNER JOIN MSysGroups AS MSG ON MSA.SID = MSG.GroupSID) INNER JOIN MSysAccounts AS MSA1 ON MSG.UserSID = MSA1.SID IN '" & strDbName & "' "
        strSQL = strSQL & "WHERE (((MSA1.Name)='" & strUserName & "') AND ((MSA.Name)='" & strGroupName & "') AND ((MSA.FGroup)<>0) AND ((MSA1.FGroup)=0));"  '));"
    Else
        strSQL = "SELECT Count(*) AS IsMemberOfGroup FROM (MSysAccounts AS MSA INNER JOIN MSysGroups AS MSG ON MSA.SID = MSG.GroupSID) INNER JOIN MSysAccounts AS MSA1 ON MSG.UserSID = MSA1.SID IN '" & SysCmd(acSysCmdGetWorkgroupFile) & "' "
        strSQL = strSQL & "WHERE (((MSA1.Name)='" & strUserName & "') AND ((MSA.Name)='" & strGroupName & "') AND ((MSA.FGroup)<>0) AND ((MSA1.FGroup)=0) AND (([MSA1].[Name] & MSA1.SID)=(SELECT MSA1.Name & MSA1.SID as UniqueID "
        strSQL = strSQL & "FROM (MSysAccounts AS MSA INNER JOIN MSysGroups AS MSG ON MSA.SID = MSG.GroupSID) INNER JOIN MSysAccounts AS MSA1 ON MSG.UserSID = MSA1.SID IN '" & strDbName & "' "
        strSQL = strSQL & "WHERE (((MSA1.Name)='" & strUserName & "') AND ((MSA.Name)='" & strGroupName & "') AND ((MSA.FGroup)<>0) AND ((MSA1.FGroup)=0));"  ' )));"
    End If
    
    On Error Resume Next
    rst.Open strSQL, CurrentProject.Connection, adOpenStatic, adLockReadOnly
    If (Err.number <> 0) Then
        Err.Clear
        bolMOG = False
    Else
        bolMOG = rst.Fields("IsMemberOfGroup").Value
        rst.Close
        Set rst = Nothing
    End If
    
    UserBelongsToGroupDB = bolMOG
    
ExitProcedure:

    Exit Function
    
ErrHandler:

    Err.Raise Err.number, "UserBelongsToGroupDB", Err.Description
    Resume ExitProcedure

End Function
 
Wow- thanks the quick response and the code. I'll try it tonight and let you know how it goes! Many thanks.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top