Solved

Retrieve Windows User priviledges vba

Posted on 2013-12-17
3
213 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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Although it can be difficult to imagine, someday your child will have a career of his or her own. He or she will likely start a family, buy a home and start having their own children. So, while being a kid is still extremely important, it’s also …
In this article, I will show you HOW TO: Install VMware Tools for Windows on a VMware Windows virtual machine on a VMware vSphere Hypervisor 6.5 (ESXi 6.5) Host Server, using the VMware Host Client. The virtual machine has Windows Server 2016 instal…
Windows 8 comes with a dramatically different user interface known as Metro. Notably missing from the new interface is a Start button and Start Menu. Many users do not like it, much preferring the interface of earlier versions — Windows 7, Windows X…
In this fifth video of the Xpdf series, we discuss and demonstrate the PDFdetach utility, which is able to list and, more importantly, extract attachments that are embedded in PDF files. It does this via a command line interface, making it suitable …

948 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

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now