Find Security Group of a User with VBA 1

[xtraterrestrial]

Hi,

Does anyone know how I can find the security group that the current user belongs to with VBA code?

ex Admin, User

 

[VBslammer]

Something like this might work:

Function GetCurrentUserGroups() As String
    Dim wrk As Workspace
    Dim usr As User
    Dim grp As Group
    Dim strGroups As String
    
    On Error Resume Next
    
    Set wrk = DBEngine.Workspaces(0)
    Set usr = wrk.Users(Application.CurrentUser)
    
    For Each grp In usr.Groups
      strGroups = strGroups & grp.Name & ","
    Next grp
    
    GetCurrentUserGroups = Left(strGroups, InStrRev(strGroups, ",") - 1)
    
End Function

VBSlammer

Unemployed in Houston, Texas

 

[LittleSmudge]

You cannot literally find "the security group that the current user belongs" because the user can be a member of many groups.

The "the security group" is therefore meaningless.

You can, however TEST to see if the current user is a member of a specific group using

Public Function InGroup(strGroupName As String) As Boolean
'# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #'
' The ADOX library is required for this function.                   '
'# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #'

Dim cat As New ADOX.Catalog
Set cat.ActiveConnection = CurrentProject.Connection

On Error GoTo InGroup_Err
InGroup = False
Dim usrUser As User
For Each usrUser In cat.Groups(strGroupName).Users
    If usrUser = CurrentUser Then
        InGroup = True
        Exit Function
    End If
Next

InGroup_Exit:
Exit Function

InGroup_Err:
If Err.Number = 3265 Then ' Supplied strGroupName is not a valid Group
'                         ' in the current connection's System.mdw
    ' Die Silently
Else
    MsgBox Err.Description, , Err.Number
End If
Resume InGroup_Exit
End Function

'ope-that-'elps.

G LS
spsinkNOJUNK@yahoo.co.uk
Remove the NOJUNK to use.

 

[VBslammer]

The DAO version I supplied does the same thing, it just returns a comma-delimited string containing the groups the current user belongs to.

You can pick through the groups using another simple function:

Function InGroup(ByVal strGroup As String) As Boolean
  Dim varGroups As Variant
  Dim i As Integer

  varGroups = Split(GetCurrentUserGroups(), ",")
  For i = 0 To UBound(varGroups)
    If UCase(varGroups(i)) = UCase(strGroup) Then
      InGroup = True
      Exit For
    End If
  Next i
End Function

VBSlammer

Unemployed in Houston, Texas

 

[xtraterrestrial]

Thanks VBSlammer

Your code works perfectly

 

[jrollins]

VBSlammer - I can't get your code to work. It doesn't seem to be reading any groups. The code is as shown, followed by the Debug.Print results:

Function InGroup(ByVal strGroup As String) As Boolean
Dim varGroups As Variant
Dim i As Integer

varGroups = Split(GetCurrentUserGroups(), ",&quot
Debug.Print "1"
For i = 0 To UBound(varGroups)
Debug.Print "2"
Debug.Print i
If UCase(varGroups(i)) = UCase(strGroup) Then
InGroup = True
Debug.Print "Current User is in RecordCreators group"
Exit For
End If
Next i
End Function

Function GetCurrentUserGroups() As String
Dim wrk As Workspace
Dim usr As User
Dim grp As Group
Dim strGroups As String

On Error Resume Next
Debug.Print "3"
Set wrk = DBEngine.Workspaces(0)
Debug.Print "4"
Set usr = wrk.Users(Application.CurrentUser)
Debug.Print "Current User = " & Application.CurrentUser
Debug.Print "5"
For Each grp In usr.Groups
Debug.Print grp.Name
strGroups = strGroups & grp.Name & ","
Debug.Print "strGroups = " & strGroups
Next grp
Debug.Print "6"
GetCurrentUserGroups = Left(strGroups, InStrRev(strGroups, ",&quot - 1)

End Function


3
4
Current User = jrollins
5
strGroups =
6
1

 

[VBslammer]

Remove the "On Error Resume Next" and see if you're getting any errors.

VBSlammer

Unemployed in Houston, Texas