Solved

VB LDAP to get a users "member of" groups, within AD

Posted on 2008-09-29
1
5,665 Views
Last Modified: 2012-05-05
HI all,
im working on a script and part of it is to find out the total number of groups a user is a member of, what that group is and what the descript of that group is.

I can count the groups (foundPerm) and also write these groups to an array (arrNames), however i have the following 2 questions:
1) is there a quicker way to do this?
2) How do i get a list in another array (arrNames1), which shows the groups description?

Thanks
''    Const ADS_SCOPE_SUBTREE = 2
''        objConnection.Provider = "ADsDSOObject"
''        objConnection.Open "Active Directory Provider"
''    Set objCommand.ActiveConnection = objConnection
''        objCommand.Properties("Page Size") = 1000
''        objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
''    On Error Resume Next
''    Set oRoot = GetObject("LDAP://RootDSE")
''    strDomain = oRoot.Get("DefaultNamingContext")
    
''    objCommand.CommandText = _
''        "SELECT distinguishedName FROM 'LDAP://" & strDomain & "' WHERE objectCategory='user' " & _
''        "AND cn='" & userGBID & "'"
''
''    Set objRecordset = objCommand.Execute
''
''    objRecordset.MoveFirst
''        Do Until objRecordset.EOF
''            result = (objRecordset.Fields("distinguishedName").Value)
''            objRecordset.MoveNext
''        Loop
''
''    Result4 = Right(result, (Len(result)) - (InStr(1, result, ",")))
''
''    strUserName = "Cn=" & userGBID & ", " & Result4 & ""
''    strUserPath = "LDAP://" & strUserName
''    Set objUser = GetObject(strUserPath)
''    intsize = 0
''    foundPerm = 0
''    For Each strGroup In objUser.memberof
''        foundPerm = foundPerm + 1 '<---- number of groups a user is member of
''        strGroupPath = "LDAP://" & strGroup
''        ReDim Preserve arrNames(intsize)
''        Set objGroup = GetObject(strGroupPath)
''        strGroup = Split(strGroup, ",OU=")
''        strGroup = Split(strGroup(0), "CN=")
''        arrNames(intsize) = Trim(strGroup(1)) '<--- array where these groups are saved
''        'arrDescription (intsize)
''        intsize = intsize + 1
''    Next
''    intRow = 1

Open in new window

0
Comment
Question by:jamiepryer
1 Comment
 
LVL 65

Accepted Solution

by:
RobSampson earned 500 total points
ID: 22602971
Hi, here's a completely different approach.....

Regards,

Rob.
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /k cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If
 
Const ADS_SCOPE_SUBTREE = 2
 
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
 
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
 
Set objRootDSE = GetObject("LDAP://RootDSE")
strDomain = objRootDSE.get("defaultNamingContext")
 
objCommand.CommandText = _
    "SELECT distinguishedName FROM 'LDAP://" & strDomain & "' WHERE objectCategory='user' AND objectClass='person'"
Set objRecordSet = objCommand.Execute
 
strResults = """distinguishedName"",""Group name"",""Group Description"""
 
If Not objRecordSet.EOF Then
	objRecordSet.MoveFirst
	Do Until objRecordSet.EOF
		WScript.Echo "Enumerating " & objRecordSet.Fields("distinguishedName").Value
		Set objUser = GetObject("LDAP://" & objRecordSet.Fields("distinguishedName").Value)
		Set colGroups = objUser.Groups
		strResults = strResults & VbCrLf & """" & objUser.distinguishedName & """"
		For Each objGroup In colGroups
			strGroupName = objGroup.CN
			strDescription = objGroup.Description
			strResults = strResults & VbCrLf & """"",""" & strGroupName & """,""" & strDescription & """"
		Next
		objRecordSet.MoveNext
	Loop
End If
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOutputFile = objFSO.CreateTextFile("Results.csv", True)
objOutputFile.Write strResults
objOutputFile.Close
MsgBox "Done"

Open in new window

0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

I met Paul Devereux (@pdevereux) today when I responded to his tweet asking “Anybody know how to automate adding files from disk to a folder in #outlook  ?”.  I replied back and told Paul that using automation, in this case scripting, to add files t…
Over the years I have built up my own little library of code snippets that I refer to when programming or writing a script.  Many of these have come from the web or adaptations from snippets I find on the Web.  Periodically I add to them when I come…
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …
I've attached the XLSM Excel spreadsheet I used in the video and also text files containing the macros used below. https://filedb.experts-exchange.com/incoming/2017/03_w12/1151775/Permutations.txt https://filedb.experts-exchange.com/incoming/201…

685 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