Solved

Retrieve Windows User priviledges vba

Posted on 2013-12-17
3
215 Views
Last Modified: 2014-01-12
In VBA, I'm trying to determine the type of privileges for the current logged in user account (Guest, standard or administrator)
0
Comment
Question by:askolits
  • 2
3 Comments
 
LVL 18

Assisted Solution

by:Steven Harris
Steven Harris earned 230 total points
ID: 39737285
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
 

Accepted Solution

by:
askolits earned 0 total points
ID: 39763144
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
 

Author Closing Comment

by:askolits
ID: 39774467
I made a modification to make it work with VBA.
0

Featured Post

Connect further...control easier

With the ATEN CE624, you can now enjoy a high-quality visual experience powered by HDBaseT technology and the convenience of a single Cat6 cable to transmit uncompressed video with zero latency and multi-streaming for dual-view applications where remote access is required.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

While rebooting windows server 2003 server , it's showing "active directory rebuilding indices please wait" at startup. It took a little while for this process to complete and once we logged on not all the services were started so another reboot is …
Computer science students often experience many of the same frustrations when going through their engineering courses. This article presents seven tips I found useful when completing a bachelors and masters degree in computing which I believe may he…
Windows 8 came with a dramatically different user interface known as Metro. Notably missing from that interface was a Start button and Start Menu. Microsoft responded to negative user feedback of the Metro interface, bringing back the Start button a…
With the advent of Windows 10, Microsoft is pushing a Get Windows 10 icon into the notification area (system tray) of qualifying computers. There are many reasons for wanting to remove this icon. This two-part Experts Exchange video Micro Tutorial s…

808 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question