Const adhcErrNameNotInCollection = 3265
Const adhcErrNoPermission = 3033
Function adhIsGroupMember(ByVal strGroup As String, _
Optional ByVal varUser As Variant) As Boolean
' Verifies if a user is a member of a group.
'
' From Access 97 Developer's Handbook
' by Litwin, Getz, and Gilbert. (Sybex)
' Copyright 1997. All Rights Reserved.
'
' In:
' strGroup: name of group
' strUser: optional name of user;
' if missing, current user is used
' Out:
' Return Value: True if user is member; False if not
' Example:
' fOK = adhIsGroupMember("Pets", "Kizzie")
On Error GoTo adhIsGroupMemberErr
Dim wrk As Workspace
Dim usr As User
Dim grp As Group
Dim strMsg As String
Dim intErrHndlrFlag As Integer
Dim varGroupName As Variant
Const adhcFlagSetUser = 1
Const adhcFlagSetGroup = 2
Const adhcFlagCheckMember = 4
Const adhcFlagElse = 0
Const adhcProcName = "adhIsGroupMember"
adhIsGroupMember = False
'Initialize flag for determining
'context for error handler
intErrHndlrFlag = adhcFlagElse
Set wrk = DBEngine.Workspaces(0)
'Refresh users and groups collections
wrk.Users.Refresh
wrk.Groups.Refresh
If IsMissing(varUser) Then varUser = CurrentUser()
intErrHndlrFlag = adhcFlagSetUser
Set usr = wrk.Users(varUser)
intErrHndlrFlag = adhcFlagSetGroup
Set grp = wrk.Groups(strGroup)
intErrHndlrFlag = adhcFlagCheckMember
varGroupName = usr.Groups(strGroup).Name
If Not IsEmpty(varGroupName) Then
adhIsGroupMember = True
End If
adhIsGroupMemberDone:
On Error GoTo 0
Exit Function
adhIsGroupMemberErr:
Select Case Err
Case adhcErrNameNotInCollection
Select Case intErrHndlrFlag
Case adhcFlagSetUser
strMsg = "The user account '" & varUser & _
"' doesn't exist."
Case adhcFlagSetGroup
strMsg = "The group account '" & strGroup & _
"' doesn't exist."
Case adhcFlagCheckMember
Resume Next
Case Else
strMsg = "Error " & Err.Number & ": " & _
Err.Description
End Select
Case adhcErrNoPermission
strMsg = "You don't have permission to perform " & _
"this operation."
Case Else
strMsg = "Error " & Err.Number & ": " & Err.Description
End Select
MsgBox strMsg, vbCritical + vbOKOnly, "Procedure " & _
adhcProcName
Resume adhIsGroupMemberDone
End Function