VBA to check 'User is in group'

It's a common question: is the user in this group? Or rather: is the user allowed to do this?

Now VBA and Excel are *not* secure platforms, so you really shouldn't use this for sensitive information and operations - get this set up properly at the database, or in the target application - but you may well be using NT groups, quite legitimately, to direct your users into different tasks and data sets, rather than using Excel as the security layer.

I'm pretty sure I've posted this on StackOverflow, some or other year ago; but this is as good a place for it as any.

I've attached a User Long Name function, because you'll almost always find yourself using this in applications that are aware of the user's network ID.

As always, watch out for Blogspot rendering an unwanted line break.

Public Function UserIsInGroup(GroupName As String, Optional Username As String, Optional Domain As String) As Boolean
' Returns TRUE if the user is in the named NT Group.

' If user name is omitted, current logged-in user's login name is assumed.
' If domain is omitted, current logged-in user's domain is assumed.
' User name can be submitted in the form 'NETWORK/UserName' - this will run slightly faster
' Does not raise errors for unknown user: they are not in the group and the function returns false.

'
' Sample Usage: UserIsInGroup( "Domain Users" )


Dim strUsername As String
Dim objGroup    As Object
Dim objUser     As Object
Dim objNetwork  As Object


UserIsInGroup = False

If Username = "" Then
    Set objNetwork = CreateObject("WScript.Network")
    strUsername = objNetwork.UserDomain & "/" & objNetwork.Username
Else
    strUsername = Username
End If


strUsername = Replace(strUsername, "\", "/")

If InStr(strUsername, "/") Then
    ' No action: Domain has already been supplied in the user name
Else

    If Domain = "" Then
        Set objNetwork = CreateObject("WScript.Network")
        Domain = objNetwork.UserDomain
    End If
    
    strUsername = Domain & "/" & strUsername
    
End If

Set objUser = GetObject("WinNT://" & strUsername & ",user")

If objUser Is Nothing Then

    ' Insert error-handler here if you want to report an unknown user name
    
Else

    For Each objGroup In objUser.Groups
    
        If GroupName = "" Then
            Debug.Print objGroup.Name
        End If
        
        If GroupName = objGroup.Name Then
            UserIsInGroup = True
            Exit For
        End If
    
    Next objGroup


End If


Set objNetwork = Nothing
Set objGroup = Nothing
Set objUser = Nothing


End Function


Public Function UserLongName(ByVal strUserID As String) As String
Application.Volatile False
On Error GoTo ErrSub


Dim strDomain As String


If strUserID = "" Then
    Exit Function
End If



If InStr(2, strUserID, "(", vbBinaryCompare) > 0 Then
    Exit Function
End If

strUserID = Replace(strUserID, "\", "/")

If InStr(strUserID, "/") Then
    UserLongName = GetObject("WinNT://" & strUserID).FullName
Else
    strDomain = CreateObject("wscript.Network").UserDomain
    UserLongName = GetObject("WinNT://" & strDomain & "/" & strUserID).FullName
End If
              
ExitSub:
    Exit Function
ErrSub:
    Resume ExitSub
                
End Function