Active Directory Query with Excel Macro

[tr3vayn3]

Hi everyone,
Im quite new to this forum, found it on my search to address my problem with a particular Macro.
Anyways, what I am trying to achieve is to pull out the list of Security groups a User is a Member Of. I came across this VBA (see below), but I could not entirely get it to work.
Our AD structure has an OU called "Enteng Users" this is were we place all our LANID's. Apart from this we also have the standard OU "Users" which we do not actually use.
I have been trying to get the script below to work, basically it is querying the LAN ID (from Excel sheet Macro) on Cell D2 and returns the value on Cell A8.
During my test, it could not return any result for LANID's on the "Enteng Users" OU while it does return results for LANID's on the "Users" OU.
I hope someone could have a look at the script and help me identify which is which and what I can do to make it work.
I am quite desperate as I have been trying to figure this out since last week but with no luck.

Thank you very much in advance and hope to hear from you.

Regards,
tr3vayn3



Script:

Option Explicit
Sub GetGroupData()
GetGroupMembership Sheet1.Range("D2").Value, Sheet1.Range("A8")
End Sub

Sub GetGroupMembership(strUser As String, rngOut As Range)

Dim objConnection, objCommand, objRecordSet, objUser, objRootDSE, objMember
Dim strLine, arrGroup

Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection

Set objRootDSE = GetObject("LDAP://RootDSE")
objCommand.CommandText = "SELECT aDSPath FROM 'LDAP://" & objRootDSE.Get("defaultNamingContext") & _
"' WHERE objectClass='user' And name='" & strUser & "'"
Set objRootDSE = Nothing

objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 600
objCommand.Properties("Cache Results") = False

Set objRecordSet = objCommand.Execute
rngOut.CurrentRegion.Offset(1).ClearContents
While Not objRecordSet.EOF
Set objUser = GetObject(objRecordSet.Fields("aDSPath"))
For Each objMember In objUser.GetEx("memberOf")
strLine = Mid(objMember, 4, 330)
arrGroup = Split(strLine, ",")
rngOut.Value = arrGroup(0)
Set rngOut = rngOut.Offset(1)
Next
' Additional section to find the primary group.
If objUser.primaryGroupID = 513 Then
rngOut.Value = "Domain Users"
Else
If objUser.primaryGroupID = 515 Then
rngOut.Value = "Domain Computers"
Else
rngOut.Value = "Maybe a Domain Controller"
End If
End If

Set objUser = Nothing
objRecordSet.MoveNext
Wend

objConnection.Close
Set objRecordSet = Nothing
Set objCommand = Nothing
Set objConnection = Nothing

End Sub

 

[evnoort]

Hi, i use this code to check if a user is a member of a certain group and then display controls or not, maybe this helps

sUser = Environ("USERNAME")
sDomain = Environ("USERDOMAIN")
sPath = "WinNT://" + sDomain

    Dim usr As IADsUser
    Set usr = GetObject(sPath & "/" & sUser)
    
    Dim grp As IADsGroup
    Dim Col As Integer

    For Each grp In usr.Groups
        'ActiveSheet.Cells(row, col).Value = grp.name
        If InStr(grp.name, "Admin") Or InStr(grp.name, "Superuser") Then
            MsgBox (grp.name)
        End If
        If grp.name = "group one" Or _
                grp.name = "group two " Then 
            bVisible = True
        End If
    Next

 

[evnoort]

You have to add a reference, I think to: Active DS Type Library

Regards. Erik

 

[tr3vayn3]

Hi Evnoort,
Thank's for your response. What I actually want to achieve is to pull out those Security groups. I believe your script is to determine if the User is an
Admin or a Superuser? Just the same many thanks ^^
Appreciate any help or perhaps a reference I could go to to maybe address this?

Cheers.

 

[tr3vayn3]

I have also posted this problem over here
Hope I could get some help..

 

[evnoort]

I once made a tool to check users security rights and member of user groups and posted it here:
http://www.xtremevbtalk.com/showthread.php?t=311162

But site seems to be down now. Maybe you have better luck

Regards,

Erik

 

[evnoort]

Site is up now, below you find the zip file. Hope this helps you
Regards.

 

[tr3vayn3]

@evnoort
Dude you are a GENIUS! Thank you so much! I have been looking for something similar to this! It's working great! Many many thanks. ^^

Cheer,
Andrew

 

[awit24]

Site is up now, below you find the zip file. Hope this helps you
Regards.

does anyone still have the file? I'm looking for this code.