Thursday, 18 September 2014

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
    strUsername = Username
End If

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

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

    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

    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
    strDomain = CreateObject("wscript.Network").UserDomain
    UserLongName = GetObject("WinNT://" & strDomain & "/" & strUserID).FullName
End If
    Exit Function
    Resume ExitSub
End Function

No comments:

Post a Comment