Adding Group membership of an userID to Excel

[edgard01]

I have a list of 200 users that I need to check each their group membership including nested group.
I wrote the script below that will read a text file where all the id's are listed. Search active directory and list the following in the spreadsheet: The displayName, sAMAccountName, EmployeeID, Groups. The script will check if the account exist in AD first. Then provide the result.
I am having problem if I replace 'Do Nothing in the script after the condition:
If (Err.Number <> 0) Then 'Do NothingEnd If

This screw up the spreadsheet. Can someone help me with the script below. Please note on the script that I used uses a recursive subroutine from rlmueller web site (http://www.rlmueller.net/MemberOf.htm). Thanks to him for the wonderfull site. I also thank scriptinganswers as well.

Dim objGroupList, objUser, objExcel, K, strAnswer, L'Open an instance of Excel add the header info Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = TrueobjExcel.Workbooks.AddSet objSheet = objExcel.ActiveWorkbook.Worksheets(1)objSheet.Name = "User Groups"
objExcel.Cells(1, 1).Value = "Full Name"objExcel.Cells(1, 2).Value = "Username"objExcel.Cells(1, 3).Value = "Employee ID"objExcel.Cells(1, 4).Value = "Group Membership"K = 2L = 2'Read the text file with the usernameConst ForReading = 1Dim arrNames()intSize = 0'read the text files where the list of department group samaccountname from a text fileSet objDictionary = CreateObject("Scripting.Dictionary")Set objFSO = CreateObject("Scripting.FileSystemObject")Set objTextFile = objFSO.OpenTextFile("c:username.txt", ForReading)i = 0
Do Until objTextFile.AtEndOfStream strNextLine = objTextFile.Readline objDictionary.Add i, strNextLine i = i + 1Loop
For Each objItem In objDictionary strAnswer = objDictionary.Item(objItem) On Error Resume Next Const ADS_SCOPE_SUBTREE = 2 DNC = GetObject("LDAP://RootDSE").Get("defaultNamingContext") 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") = 1 objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE objCommand.CommandText = "SELECT Adspath FROM 'LDAP://" & DNC & "'" & _ " WHERE name='" & strAnswer & "'" & " OR sAMAccountName='" & strAnswer & "'" Set objRecordSet = objCommand.Execute objRecordSet.MoveFirst If (Err.Number <> 0) Then 'Do Nothing End If Set objUser = GetObject(objRecordSet.Fields("AdsPath").Value) Set objUser = GetObject("LDAP://" & objUser.distinguishedName) objExcel.Cells(L, 1).Value = objUser.displayName objExcel.Cells(L, 2).Value = objUser.sAMAccountName objExcel.Cells(L, 3).Value = objUser.employeeID ' Bind to dictionary object. Set objGroupList = CreateObject("Scripting.Dictionary") ' Enumerate group memberships. Call EnumGroups(objUser) ' Clean up. Set objGroupList = Nothing Set objUser = Nothing K = K + 1 L = L + 1Next
Sub EnumGroups(ByVal objADObject) ' Recursive subroutine to enumerate user group memberships. ' Includes nested group memberships. Dim colstrGroups, objGroup, j objGroupList.CompareMode = vbTextCompare colstrGroups = objADObject.memberOf If (IsEmpty(colstrGroups) = True) Then Exit Sub End If If (TypeName(colstrGroups) = "String") Then ' Escape any forward slash characters, "/", with the backslash ' escape character. All other characters that should be escaped are. colstrGroups = Replace(colstrGroups, "/", "/") Set objGroup = GetObject("LDAP://" & colstrGroups) If (objGroupList.Exists(objGroup.sAMAccountName) = False) Then objGroupList.Add objGroup.sAMAccountName, True objExcel.Cells(L, 4).Value = objGroup.distinguishedName L = L + 1 'Wscript.Echo objGroup.distinguishedName Call EnumGroups(objGroup) End If Set objGroup = Nothing Exit Sub End If For j = 0 To UBound(colstrGroups) ' Escape any forward slash characters, "/", with the backslash ' escape character. All other characters that should be escaped are. colstrGroups(j) = Replace(colstrGroups(j), "/", "/") Set objGroup = GetObject("LDAP://" & colstrGroups(j)) If (objGroupList.Exists(objGroup.sAMAccountName) = False) Then objGroupList.Add objGroup.sAMAccountName, True objExcel.Cells(L, 4).Value = objGroup.distinguishedName L = L + 1 'Wscript.Echo objGroup.distinguishedName Call EnumGroups(objGroup) End If Next Set objGroup = NothingEnd Sub

[jvierra]

You should not be getting an error on a reset except if the recordset is empty. Empty recordset don't enumerate so you can safely ignore the error handling.

Remove the offending code (comment out for now) and comment out teh "On Error Resume Next". You shouyld not use this line of code if you are not handling all errors your self. The code posted does NO error handling so the line is a problem.

Due to these changes you may find some bad code design which we will have to deal with after you get the code to run past this condition.

Post back with the errors you get including the line of code causing the error.

[jvierra]

Here is the missing user getter safely function.

I had to modify it for you case.

The is no 'DisplayName" so you need to create it from the till. If yu are looking fo Exchange Display name you need to query a different object for that. It is part of the users mailbox and not teh users account.

Code: Select all

' ldap is LDAP://dc=domain,dc=com format for user domain
' samAccountName is user id in AD
' FUnction returns user objects with queried fields OR Empty recordset if user not found.
'  Call thusly:
'       Set myRS = GetUser( "LDAP://...","useraccoun23"
'       If myRS.RecordCount > 0  Then
          '  continue precessing else skip.
Function GetUser(ldap, samAccountName)
    Dim oConn, oCmd
    
    Set oConn = CreateObject("ADODB.Connection")
    oConn.Provider = "ADsDSOObject"
    oConn.Open "Active Directory Provider"
    Set GetUser = oConn.Execute("SELECT aDSPath,distinguishedName, SN, GivenName, EmployeeID FROM '" & ldap & "' WHERE samAccountName='" & samAccountName & "'")
End Function