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 Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

current user's groups?

Status
Not open for further replies.

medwards

Programmer
Nov 9, 2001
8
0
0
US
Is there a function that returns the current user's groups? if not, is there another way to do it? thanks.
 

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 & &quot;; &quot;
Next grpLoop
Else
sGroup = &quot; [None]&quot;
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) & &quot;,&quot; & Err.Description & &quot;;&quot;
GoTo DocSkip
Case Else
Call HandleTheError(&quot;basPermissions&quot;, &quot;UserIsMemberOfGroup&quot;, Err, ShowMsg)
End Select
Resume Proc_Exit
Resume

End Function

Steve King Growth follows a healthy professional curiosity
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top