Export AD Users and Group Member Ship

[msperano]

This seems to be asked alot. I have been using this script to export A
objmembers (users) to excell and works great. What I would also like t
do is add groupmemberships to the same script to add another row in th
excel output. I found a bunch of scripts that will do the groups b
themselves and show members. Can anyone help combine these two scripts.
Thanks
Mike
I attached the two scripts, User Exports Works Great.txt is the workin
one and I would like to combine the Group Membership with it.

****First working one******

Dim ObjWb
Dim ObjExcel
Dim x, zz
Set objRoot = GetObject("LDAP://ROotDSE")
strDNC = objRoot.Get("DefaultNamingContext")
'strOU = InputBox("Enter the name of an OU")
Set objDomain = GetObject("LDAP://" & strDNC)
'Set objDomain = GetObject("LDAP://ou=" & strOU & "," & strDNC) ' Bin
to the top of the Domain using LDAP using ROotDSE
Call ExcelSetup("Sheet1") ' Sub to make Excel Document
x = 1
Call enummembers(objDomain)
Sub enumMembers(objDomain)
On Error Resume Next
Dim Secondary(20) ' Variable to store the Array of 2ndary email alias'

For Each objMember In objDomain ' go through the collection

If ObjMember.Class = "user" Then ' if not User object, move on.
x = x +1 ' counter used to increment the cells in Excel

objwb.Cells(x, 1).Value = objMember.Class
' I set AD properties to variables so if needed you could do Nul
checks or add if/then's to this code
' this was done so the script could be modified easier.
SamAccountName = ObjMember.samAccountName
Cn = ObjMember.CN
FirstName = objMember.GivenName
LastName = objMember.sn
'Profile = objMember.profilePath
'LoginScript = objMember.scriptpath
HomeDirectory = ObjMember.HomeDirectory
HomeDrive = ObjMember.homeDrive
AdsPath = Objmember.Adspath
LastLogin = objMember.LastLogin

zz = 1 ' Counter for array of 2ndary email addresses
For each email in ObjMember.proxyAddresses
If Left (email,5) = "SMTP:" Then
Primary = Mid (email,6) ' if SMTP is all caps, then it's the Primary
ElseIf Left (email,5) = "smtp:" Then
Secondary(zz) = Mid (email,6) ' load the list of 2ndary SMT
emails into Array.
zz = zz + 1
End If
Next
' Write the values to Excel, using the X counter to increment the rows


objwb.Cells(x, 2).Value = SamAccountName
objwb.Cells(x, 3).Value = CN
objwb.Cells(x, 4).Value = FirstName
objwb.Cells(x, 5).Value = LastName
'objwb.Cells(x, 6).Value = Profile
'objwb.Cells(x, 7).Value = LoginScript
objwb.Cells(x, 8).Value = HomeDirectory
objwb.Cells(x, 9).Value = HomeDrive
objwb.Cells(x, 10).Value = Adspath
objwb.Cells(x, 11).Value = LastLogin

' Write out the Array for the 2ndary email addresses.
For ll = 1 To 20
objwb.Cells(x,26+ll).Value = Secondary(ll)
Next
' Blank out Variables in case the next object doesn't have a value fo
the property
SamAccountName = "-"
Cn = "-"
FirstName = "-"
LastName = "-"
Profile = "-"
LoginScript = "-"
HomeDirectory = "-"
HomeDrive = "-"
For ll = 1 To 20
Secondary(ll) = ""
Next
End If

' If the AD enumeration runs into an OU object, call the Sub again t
itinerate

If objMember.Class = "organizationalUnit" or OBjMember.Class
"container" Then
enumMembers (objMember)
End If
Next
End Sub
Sub ExcelSetup(shtName) ' This sub creates an Excel worksheet and add
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, 2).Value = "SamAccountName"
objwb.Cells(1, 3).Value = "CN"
objwb.Cells(1, 4).Value = "FirstName"
objwb.Cells(1, 5).Value = "LastName"
'objwb.Cells(1, 6).Value = "Profile"
'objwb.Cells(1, 7).Value = "LoginScript"
objwb.Cells(1, 8).Value = "HomeDirectory"
objwb.Cells(1, 9).Value = "HomeDrive"
objwb.Cells(1, 10).Value = "Adspath"
objwb.Cells(1, 11).Value = "LastLogin"
End Sub
MsgBox "Done" ' show that script is complete

******Second one*****



Set objUser=GetObject("LDAP://CN=Mike Sperano," & _
"OU=Mike Test OU,DC=FCSD,DC=local")
Set colGroups = objUser.Groups
For Each objGroup in colGroups
Wscript.Echo objGroup.CN
GetNested(objGroup)
Next
Function GetNested(objGroup)
On Error Resume Next
colMembers = objGroup.GetEx("memberOf")
For Each strMember in colMembers
strPath = "LDAP://" & strMember
Set objNestedGroup = _
GetObject(strPath)
WScript.Echo objNestedGroup.CN
GetNested(objNestedGroup)
Next
End Function


+-------------------------------------------------------------------+
|Filename: Group Membership6.txt |
|Download: http://forums.techarena.in/attachment.php?attachmentid=10890|
+-------------------------------------------------------------------+

[Richard Mueller [MVP]]

This seems to be asked alot. I have been using this script to export AD
objmembers (users) to excell and works great. What I would also like to
do is add groupmemberships to the same script to add another row in the
excel output. I found a bunch of scripts that will do the groups by
themselves and show members. Can anyone help combine these two scripts.
Thanks
Mike
I attached the two scripts, User Exports Works Great.txt is the working
one and I would like to combine the Group Membership with it.
****First working one******
Dim ObjWb
Dim ObjExcel
Dim x, zz
Set objRoot = GetObject("LDAP://ROotDSE")
strDNC = objRoot.Get("DefaultNamingContext")
'strOU = InputBox("Enter the name of an OU")
Set objDomain = GetObject("LDAP://" & strDNC)
'Set objDomain = GetObject("LDAP://ou=" & strOU & "," & strDNC) ' Bind
to the top of the Domain using LDAP using ROotDSE
Call ExcelSetup("Sheet1") ' Sub to make Excel Document
x = 1
Call enummembers(objDomain)
Sub enumMembers(objDomain)
On Error Resume Next
Dim Secondary(20) ' Variable to store the Array of 2ndary email alias's
For Each objMember In objDomain ' go through the collection
If ObjMember.Class = "user" Then ' if not User object, move on.
x = x +1 ' counter used to increment the cells in Excel
objwb.Cells(x, 1).Value = objMember.Class
' I set AD properties to variables so if needed you could do Null
checks or add if/then's to this code
' this was done so the script could be modified easier.
SamAccountName = ObjMember.samAccountName
Cn = ObjMember.CN
FirstName = objMember.GivenName
LastName = objMember.sn
'Profile = objMember.profilePath
'LoginScript = objMember.scriptpath
HomeDirectory = ObjMember.HomeDirectory
HomeDrive = ObjMember.homeDrive
AdsPath = Objmember.Adspath
LastLogin = objMember.LastLogin
zz = 1 ' Counter for array of 2ndary email addresses
For each email in ObjMember.proxyAddresses
If Left (email,5) = "SMTP:" Then
Primary = Mid (email,6) ' if SMTP is all caps, then it's the Primary
ElseIf Left (email,5) = "smtp:" Then
Secondary(zz) = Mid (email,6) ' load the list of 2ndary SMTP
emails into Array.
zz = zz + 1
End If
Next
' Write the values to Excel, using the X counter to increment the rows.
objwb.Cells(x, 2).Value = SamAccountName
objwb.Cells(x, 3).Value = CN
objwb.Cells(x, 4).Value = FirstName
objwb.Cells(x, 5).Value = LastName
'objwb.Cells(x, 6).Value = Profile
'objwb.Cells(x, 7).Value = LoginScript
objwb.Cells(x, 8).Value = HomeDirectory
objwb.Cells(x, 9).Value = HomeDrive
objwb.Cells(x, 10).Value = Adspath
objwb.Cells(x, 11).Value = LastLogin
' Write out the Array for the 2ndary email addresses.
For ll = 1 To 20
objwb.Cells(x,26+ll).Value = Secondary(ll)
Next
' Blank out Variables in case the next object doesn't have a value for
the property
SamAccountName = "-"
Cn = "-"
FirstName = "-"
LastName = "-"
Profile = "-"
LoginScript = "-"
HomeDirectory = "-"
HomeDrive = "-"
For ll = 1 To 20
Secondary(ll) = ""
Next
End If
' If the AD enumeration runs into an OU object, call the Sub again to
itinerate
If objMember.Class = "organizationalUnit" or OBjMember.Class =
"container" Then
enumMembers (objMember)
End If
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, 2).Value = "SamAccountName"
objwb.Cells(1, 3).Value = "CN"
objwb.Cells(1, 4).Value = "FirstName"
objwb.Cells(1, 5).Value = "LastName"
'objwb.Cells(1, 6).Value = "Profile"
'objwb.Cells(1, 7).Value = "LoginScript"
objwb.Cells(1, 8).Value = "HomeDirectory"
objwb.Cells(1, 9).Value = "HomeDrive"
objwb.Cells(1, 10).Value = "Adspath"
objwb.Cells(1, 11).Value = "LastLogin"
End Sub
MsgBox "Done" ' show that script is complete
******Second one*****
Set objUser=GetObject("LDAP://CN=Mike Sperano," & _
"OU=Mike Test OU,DC=FCSD,DC=local")
Set colGroups = objUser.Groups
For Each objGroup in colGroups
Wscript.Echo objGroup.CN
GetNested(objGroup)
Next
Function GetNested(objGroup)
On Error Resume Next
colMembers = objGroup.GetEx("memberOf")
For Each strMember in colMembers
strPath = "LDAP://" & strMember
Set objNestedGroup = _
GetObject(strPath)
WScript.Echo objNestedGroup.CN
GetNested(objNestedGroup)
Next
End Function
+-------------------------------------------------------------------+
|Filename: Group Membership6.txt |
|Download: http://forums.techarena.in/attachment.php?attachmentid=10890|
+-------------------------------------------------------------------+
--
msperano
------------------------------------------------------------------------
msperano's Profile: http://forums.techarena.in/members/216856.htm
View this thread: http://forums.techarena.in/server-scripting/1333960.htm
http://forums.techarena.in

Assuming your first script works, you can add code to document the nested
group memberships. However, the second script you have has potential
problems. The memberOf attribute is multi-valued, and the code must account
for the 3 possible situations: memberOf is empty, memberOf has one DN value,
or memberOf has more than one DN value. Your function avoids the error when
memberOf is empty by ignoring it, which is OK. However, circular nested
groups will be a problem. Plus, there could be duplicates even if the group
nesting is not circular. I use a dictionary object to track groups and skip
if a duplicate is found.

I generally document groups last, and write each group name to a column. I
use as many columns as necessary. You have a problem because you already do
this with email addresses. There is no way to make the values line up in the
columns, unless you restrict the number of values somehow. In the code
below, I assume you do not document email addresses. After the value is
written to column 11 of the spreadsheet, I would create the dictionary
object and call a Sub to enumerate group memberships. For example:
=========
' ...
objwb.Cells(x, 11).Value = LastLogin

' Setup dictionary object to track groups and prevent infinite loop.
Set objList = CreateObject("Scripting.Dictionary")
objList.CompareMode = vbTextCompare

' Document nested group membership.
Call NestedGroups(objMember, x, 11)
========
The sub would be as follows:
========
Sub NestedGroups(ByVal objParent, ByVal j, ByVal k)
' 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
If (TypeName(arrGroups) = "String") Then
Set objGroup = GetObject("LDAP://" & arrGroups)
If (objList.Exists(objGroup.distinguishedName) = True) Then
Exit Sub
End If
k = k + 1
objwb.Cells(j, k).Value = objGroup.cn
objList.Add objGroup.distinguishedName, True
Call NestedGroups(objGroup, j, k)
Exit Sub
End If
For Each strGroup In arrGroups
Set objGroup = GetObject("LDAP://" & strGroup)
If (objList.Exists(objGroup.distinguishedName) = False) Then
k = k + 1
objwb.Cells(j, k).Value = objGroup.cn
objList.Add objGroup.distinguishedName, True
Call NestedGroups(objGroup, j, k)
End If
Next
End Sub
==========
Another option is document all email addresses and/or all group memberships
in a single column, perhaps delimited with semicolons. I hope this helps.

[msperano]

I appreciat you taking the time to help, But I am not a scriptor nor can
I pretend to understand where in the first script I should add these
changes. I have tried several ways but I keep getting errors. Would you
be so kind as to identify where the changes should be added or add them
and repost the script with the changes made. I really appreciat your
help.
Thanks
Mike

[Richard Mueller [MVP]]

Post by msperano
I appreciat you taking the time to help, But I am not a scriptor nor can
I pretend to understand where in the first script I should add these
changes. I have tried several ways but I keep getting errors. Would you
be so kind as to identify where the changes should be added or add them
and repost the script with the changes made. I really appreciat your
help.
Thanks
Mike

I had to remove "On Error Resume Next" to troubleshoot, but I got it to
work. I decided to place all email addresses in one cell delimited by
semicolons, so I could document groups in cells to the right of that. I have
groups with "/" characters, so I had to modify the Sub to escape those
characters with "\/". I also had to add a step to clear the dictionary
object after each user was documented. I added profilePath and scriptPath
back in, so there would not be blank columns. The program that worked for me
follows:
===========
Dim ObjWb
Dim ObjExcel
Dim x
Dim strEmailAddrs, arrAddrs

Set objRoot = GetObject("LDAP://ROotDSE")
strDNC = objRoot.Get("DefaultNamingContext")
'strOU = InputBox("Enter the name of an OU")
Set objDomain = GetObject("LDAP://" & strDNC)
'Set objDomain = GetObject("LDAP://ou=" & strOU & "," & strDNC) ' Bind to
the top of the Domain using LDAP using ROotDSE

' Setup dictionary object to track groups and prevent infinite loop.
Set objList = CreateObject("Scripting.Dictionary")
objList.CompareMode = vbTextCompare

Call ExcelSetup("Sheet1") ' Sub to make Excel Document
x = 1
Call enummembers(objDomain)

Sub enumMembers(objDomain)
' On Error Resume Next

For Each objMember In objDomain ' go through the collection

If ObjMember.Class = "user" Then ' if not User object, move on.
x = x +1 ' counter used to increment the cells in Excel

objwb.Cells(x, 1).Value = objMember.Class
' I set AD properties to variables so if needed you could do Null checks or
add if/then's to this code
' this was done so the script could be modified easier.
SamAccountName = ObjMember.samAccountName
Cn = ObjMember.CN
FirstName = objMember.GivenName
LastName = objMember.sn
Profile = objMember.profilePath
LoginScript = objMember.scriptpath
HomeDirectory = ObjMember.HomeDirectory
HomeDrive = ObjMember.homeDrive
AdsPath = Objmember.Adspath
On Error Resume Next
LastLogin = objMember.LastLogin
If (Err.Number <> 0) Then
LastLogin = "<Never>"
End If
On Error GoTo 0

strEmailAddrs = ""
arrAddrs = objMember.proxyAddresses
If (IsEmpty(arrAddrs) = True) Then
strEmailAddrs = "<None>"
ElseIf (TypeName(arrAddrs) = "String") Then
strEmailAddrs = Mid(arrAddrs, 6)
Else
For Each Email In arrAddrs
If (strEmailAddrs = "") Then
strEmailAddrs = Mid(Email, 6)
Else
strEmailAddrs = strEmailAddrs & ";" & Mid(Email, 6)
End If
Next
End If

' Write the values to Excel, using the X counter to increment the rows.

objwb.Cells(x, 2).Value = SamAccountName
objwb.Cells(x, 3).Value = CN
objwb.Cells(x, 4).Value = FirstName
objwb.Cells(x, 5).Value = LastName
objwb.Cells(x, 6).Value = Profile
objwb.Cells(x, 7).Value = LoginScript
objwb.Cells(x, 8).Value = HomeDirectory
objwb.Cells(x, 9).Value = HomeDrive
objwb.Cells(x, 10).Value = Adspath
objwb.Cells(x, 11).Value = LastLogin

objwb.Cells(x, 12).Value = strEmailAddrs

' Document nested group membership.
Call NestedGroups(objMember, x, 12)

' Remove all groups in Dictionary object for next user.
objList.RemoveAll

' Blank out Variables in case the next object doesn't have a value for the
property
SamAccountName = "-"
Cn = "-"
FirstName = "-"
LastName = "-"
Profile = "-"
LoginScript = "-"
HomeDirectory = "-"
HomeDrive = "-"
End If

' If the AD enumeration runs into an OU object, call the Sub again to
itinerate

If objMember.Class = "organizationalUnit" or OBjMember.Class = "container"
Then
enumMembers (objMember)
End If
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 = "FirstName"
objwb.Cells(1, 5).Value = "LastName"
objwb.Cells(1, 6).Value = "Profile"
objwb.Cells(1, 7).Value = "LoginScript"
objwb.Cells(1, 8).Value = "HomeDirectory"
objwb.Cells(1, 9).Value = "HomeDrive"
objwb.Cells(1, 10).Value = "Adspath"
objwb.Cells(1, 11).Value = "LastLogin"
objwb.Cells(1, 12).Value = "Email Addresses"
objwb.Cells(1, 13).Value = "Group memberships"
End Sub
MsgBox "Done" ' show that script is complete

Sub NestedGroups(ByVal objParent, ByRef j, ByRef k)
' 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
If (TypeName(arrGroups) = "String") Then
arrGroups = Replace(arrGroups, "/", "\/")
Set objGroup = GetObject("LDAP://" & arrGroups)
If (objList.Exists(objGroup.distinguishedName) = True) Then
Exit Sub
End If
k = k + 1
objwb.Cells(j, k).Value = objGroup.cn
objList.Add objGroup.distinguishedName, True
Call NestedGroups(objGroup, j, k)
Exit Sub
End If
For Each strGroup In arrGroups
strGroup = Replace(strGroup, "/", "\/")
Set objGroup = GetObject("LDAP://" & strGroup)
If (objList.Exists(objGroup.distinguishedName) = False) Then
k = k + 1
objwb.Cells(j, k).Value = objGroup.cn
objList.Add objGroup.distinguishedName, True
Call NestedGroups(objGroup, j, k)
End If
Next

End Sub

[msperano]

Thanks again for this