Here is a function that I wrote to list groups for the current user.
Function FindCurrentUserGroups()
Dim wrkDefault As Workspace
Dim usrLoop As User
Dim grpLoop As Group
Dim sGroups As String, sUser As String
sUser = CurrentUser
Set wrkDefault = DBEngine.Workspaces(0)
With wrkDefault
For Each usrLoop In .Users
If usrLoop.Name = sUser Then
If usrLoop.Groups.Count <> 0 Then
For Each grpLoop In usrLoop.Groups
sGroups = sGroups & grpLoop.Name & "; "
Next grpLoop
Else
sGroup = " [None]"
End If
End If
Next usrLoop
End With
FindCurrentUserGroups = sGroups
End Function Terry L. Broadbent FAQ183-874 contains tips for posting questions in these forums.
NOTE: Reference to the FAQ is not directed at any individual.
And then this one just determines if the user is a member of a certain group.
Public Function UserIsMemberOfGroup(strUsr As String, strGrp As String) As Boolean
' This function determines the groups the current user is assigned
' and returns true if the user is a member of the group being
' tested by the parameter strGrp
' Parameters:
' strUsr is a string value for the user to test
' strGrp is a string value for a valid group
Dim wsp As Workspace
Dim dbs As Database
Dim usr As User
Dim grp As Group
Dim strGrps As String
On Error GoTo HandleErr
' Return reference to default workspace.
Set wsp = DBEngine.Workspaces(0)
' Return reference to current database.
Set dbs = CurrentDb
' Set User object to the CurrentUser
Set usr = wsp.Users(strUsr)
For Each grp In usr.Groups
If grp.Name = strGrp Then
UserIsMemberOfGroup = True
GoTo Proc_Exit
End If
DocSkip:
Next grp
Proc_Exit:
Set wsp = Nothing
Set dbs = Nothing
Set usr = Nothing
Set grp = Nothing
Exit Function
HandleErr:
Select Case Err.Number
Case 3033 ' No Permissions
mstrErrors = mstrErrors & PadErrNumber(Err.Number) & "," & Err.Description & ";"
GoTo DocSkip
Case Else
Call HandleTheError("basPermissions", "UserIsMemberOfGroup", Err, ShowMsg)
End Select
Resume Proc_Exit
Resume
End Function
Steve King Growth follows a healthy professional curiosity
This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
By continuing to use this site, you are consenting to our use of cookies.