Quantcast
Channel: The Official Scripting Guys Forum! forum
Viewing all articles
Browse latest Browse all 15028

VBS nested script to store output in one cell in excel

$
0
0

I am working on a script in extracting AD User Account info to excel using VBS.  Extraction was successful but I want all the group membership of each user to reside only in 1 cell (alligned on each row alloted for each user).  Currently all group memberships of each user just increments on the same column.  Can someone share the correct script to add in the nested loop (for group membership extraction).  Below is the part where I think the correct script should be placed.

----------

Next
End Sub
Sub ExcelSetup(shtName) ' This sub creates an Excel worksheet and adds Column heads to the 1st row
Set objExcel = CreateObject("Excel.Application")
Set objwb = objExcel.Workbooks.Add
Set objwb = objExcel.ActiveWorkbook.Worksheets(shtName)
Objwb.Name = "Active Directory Users" ' name the sheet
objwb.Activate
objExcel.Visible = True
objwb.Cells(1, 1).Value = "Class"
objwb.Cells(1, 2).Value = "SamAccountName"
objwb.Cells(1, 3).Value = "CN"
objwb.Cells(1, 4).Value = "LastLogin"
objwb.Cells(1, 5).Value = "WhenCreated"
objwb.Cells(1, 6).Value = "Disabled"
objwb.Cells(1, 7).Value = "GroupMemberships"

End Sub
MsgBox "Done Extracting AD User Accounts Info" ' show that script is complete

On Error Resume Next

Sub NestedGroups(ByVal objParent, ByRef j, ByRef g)
' Subroutine to document nested group membership.
' j is the row of the spreadsheet, k the column.
Dim objGroup, arrGroups, strGroup

arrGroups = objParent.memberOf
If (IsEmpty(arrGroups) = True) Then
Exit Sub
End If

On Error Resume Next
If (TypeName(arrGroups) = "String") Then
arrGroups = Replace(arrGroups, "/", "\/")
Set objGroup = GetObject("LDAP://" & arrGroups)
If (objList.Exists(objGroup.distinguishedName) = True) Then
Exit Sub
End If

On Error Resume Next
j = j + 1
objwb.Cells(j, g).Value = objGroup.cn
objList.Add objGroup.distinguishedName, True
Call NestedGroups(objGroup, j, g)
Exit Sub
End If

On Error Resume Next
For Each strGroup In arrGroups
strGroup = Replace(strGroup, "/", "\/")
Set objGroup = GetObject("LDAP://" & strGroup)
If (objList.Exists(objGroup.distinguishedName) = False) Then
j = j + 1
objwb.Cells(j, g).Value = objGroup.cn
objList.Add objGroup.distinguishedName, True
Call NestedGroups(objGroup, j, g)
End If

On Error Resume Next

Next

End Su


Viewing all articles
Browse latest Browse all 15028

Trending Articles