Retrieve Windows User priviledges vba

In VBA, I'm trying to determine the type of privileges for the current logged in user account (Guest, standard or administrator)
askolitsAsked:
Who is Participating?
 
askolitsConnect With a Mentor Author Commented:
Finally got around to testing this.
I needed it for VBA and I have modified it to work with VBA.
I'm going to play around with it a bit more with different OS's, but it seems to work for me.

Option Compare Database
Option Explicit

Public objNetwork, objLocalGroup
Public objTrans, strComputer, strNetBIOSDomain

Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1


Sub EnumLocalGroup(ByVal objGroup)
    Dim objMember
    For Each objMember In objGroup.Members
        Debug.Print objMember.AdsPath
        If (LCase(objMember.Class) = "group") Then
            If (InStr(LCase(objMember.AdsPath), "/" _
                    & LCase(strComputer) & "/") > 0) Then
                Call EnumLocalGroup(objMember)
            ElseIf (InStr(LCase(objMember.AdsPath), _
                    "/nt authority/") > 0) Then
            Else
                Call EnumDomainGroup(objMember, True)
            End If
        End If
    Next
End Sub
Sub EnumDomainGroup(ByVal objDomainGroup, ByVal blnNT)
    Dim strNTName, strGroupDN, objGroup, objMember
    If (IsEmpty(objTrans) = True) Then
        Set objTrans = CreateObject("NameTranslate")
        objTrans.Init ADS_NAME_INITTYPE_GC, ""

        strNTName = strNetBIOSDomain & "\" & objDomainGroup.Name
        objTrans.Set ADS_NAME_TYPE_NT4, strNTName
        strGroupDN = objTrans.Get(ADS_NAME_TYPE_1779)
        strGroupDN = Replace(strGroupDN, "/", "\/")
    Else
        If (blnNT = True) Then
            strNTName = strNetBIOSDomain & "\" & objDomainGroup.Name
            objTrans.Set ADS_NAME_TYPE_NT4, strNTName
            strGroupDN = objTrans.Get(ADS_NAME_TYPE_1779)
            strGroupDN = Replace(strGroupDN, "/", "\/")
        Else
            strGroupDN = objDomainGroup.distinguishedName
            strGroupDN = Replace(strGroupDN, "/", "\/")
        End If
    End If
    If (blnNT = True) Then
        Set objGroup = GetObject("LDAP://" & strGroupDN)
    Else
        Set objGroup = objDomainGroup
    End If
    For Each objMember In objGroup.Members
        Debug.Print objMember.AdsPath
        If (LCase(objMember.Class) = "group") Then
            Call EnumDomainGroup(objMember, False)
        End If
    Next
End Sub

Sub GetCurrentUserLevel()
Set objNetwork = CreateObject("Wscript.Network")
strNetBIOSDomain = objNetwork.UserDomain
strComputer = objNetwork.computername
Set objNetwork = Nothing
Set objLocalGroup = GetObject("WinNT://" & strComputer _
    & "/Administrators,group")
Call EnumLocalGroup(objLocalGroup)
 
End Sub

Open in new window

0
 
Steven HarrisConnect With a Mentor PresidentCommented:
VB or VBA?

With VB, you can use the following which will look for the current user, displayed as GROUP, then USER:

Option Explicit
Dim objNetwork, objLocalGroup
Dim objTrans, strComputer, strNetBIOSDomain
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
Set objNetwork = CreateObject("Wscript.Network")
strNetBIOSDomain = objNetwork.UserDomain
strComputer = objNetwork.ComputerName
Set objNetwork = Nothing
Set objLocalGroup = GetObject("WinNT://" & strComputer _
    & "/Administrators,group")
Call EnumLocalGroup(objLocalGroup)
Sub EnumLocalGroup(ByVal objGroup)
    Dim objMember
    For Each objMember In objGroup.Members
        Wscript.Echo objMember.AdsPath
        If (LCase(objMember.Class) = "group") Then
            If (InStr(LCase(objMember.AdsPath), "/" _
                    & LCase(strComputer) & "/") > 0) Then
                Call EnumLocalGroup(objMember)
            ElseIf (InStr(LCase(objMember.AdsPath), _
                    "/nt authority/") > 0) Then
            Else
                Call EnumDomainGroup(objMember, True)
            End If
        End If
    Next
End Sub
Sub EnumDomainGroup(ByVal objDomainGroup, ByVal blnNT)
    Dim strNTName, strGroupDN, objGroup, objMember
    If (IsEmpty(objTrans) = True) Then
        Set objTrans = CreateObject("NameTranslate")
        objTrans.Init ADS_NAME_INITTYPE_GC, ""

        strNTName = strNetBIOSDomain & "\" & objDomainGroup.Name
        objTrans.Set ADS_NAME_TYPE_NT4, strNTName
        strGroupDN = objTrans.Get(ADS_NAME_TYPE_1779)
        strGroupDN = Replace(strGroupDN, "/", "\/")
    Else
        If (blnNT = True) Then
            strNTName = strNetBIOSDomain & "\" & objDomainGroup.Name
            objTrans.Set ADS_NAME_TYPE_NT4, strNTName
            strGroupDN = objTrans.Get(ADS_NAME_TYPE_1779)
            strGroupDN = Replace(strGroupDN, "/", "\/")
        Else
            strGroupDN = objDomainGroup.distinguishedName
            strGroupDN = Replace(strGroupDN, "/", "\/")
        End If
    End If
    If (blnNT = True) Then
        Set objGroup = GetObject("LDAP://" & strGroupDN)
    Else
        Set objGroup = objDomainGroup
    End If
    For Each objMember In objGroup.Members
        Wscript.Echo objMember.AdsPath
        If (LCase(objMember.Class) = "group") Then
            Call EnumDomainGroup(objMember, False)
        End If
    Next
End Sub

Open in new window

0
 
askolitsAuthor Commented:
I made a modification to make it work with VBA.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.