Solved

VBScript to export members of Groups and export to Excel

Posted on 2010-08-24
14
2,103 Views
Last Modified: 2012-05-10
hihi,

I'm trying to Export members of Groups into Excel, each group is a new worksheet.

The answer in this question works OK:

http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_26298266.html?sfQueryTermInfo=1+10+30+distribut+excel+export+get+group+member+script

Except I would like it to just populate each worksheet, not ask me to click OK for each user.

The maximum character length for worksheet names is 31 characters, some of the groups are longer than 31 characters and the script stops there, is there any way to just cap the worksheet name at 31 characters?

thanks
0
Comment
Question by:brettkm
  • 7
  • 7
14 Comments
 
LVL 65

Accepted Solution

by:
RobSampson earned 500 total points
ID: 33518190
Hi, I have commented out the WScript.Echo lines, and changed this line
      .ActiveSheet.Name= groupName

to this
      .ActiveSheet.Name= Left(groupName, 31)

Regards,

Rob.
Option Explicit

Dim adoCommand, adoConnection, strBase, strFilter, strAttributes
Dim objRootDSE, strDNSDomain, strQuery, adoRecordset, strName,groupType,groupName,iRow
Dim objExcel,arrMembers, strMember

' Setup ADO objects.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection

' Search entire Active Directory domain.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strBase = "<LDAP://" & strDNSDomain & ">"

' Filter on distribution groups.
strFilter = "(objectCategory=group)"

' Comma delimited list of attribute values to retrieve.
strAttributes = "distinguishedName,member,groupType,name"

' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False

' Run the query.
Set adoRecordset = adoCommand.Execute

Set objExcel = CreateObject("Excel.Application")
With objExcel
.SheetsInNewWorkbook = 1
.Workbooks.Add
.Visible = True

' Enumerate the resulting recordset.
Do Until adoRecordset.EOF
' Retrieve values and display.
strName = adoRecordset.Fields("distinguishedName").Value
groupType  = adoRecordset.Fields("groupType").Value
groupName  = Replace(adoRecordset.Fields("name").Value,"CN=", "")

'get only distribution groups
if groupType=2 or groupType=4 or groupType=8 then
	irow=1
	.ActiveWorkbook.Worksheets.Add
	.ActiveSheet.Name= Left(groupName, 31)
	arrMembers = adoRecordset.Fields("member").Value

	'Wscript.Echo "Distribution Group: " & strName
	If IsNull(arrMembers) Then
		'Wscript.Echo "-- <No Members>"
	Else
		For Each strMember In arrMembers
			'Wscript.Echo "-- " & strMember
			Set objRootDSE = GetObject("LDAP://"&strMember)
			.Cells(iRow,1) = Replace(objRootDSE.Name,"CN=", "")
			irow=irow + 1
		Next
	End If
End If
' Move to the next record in the recordset.
adoRecordset.MoveNext
Loop
.Columns(1).entirecolumn.autofit
End With

' Clean up.
adoRecordset.Close
adoConnection.Close
Set objExcel = Nothing

Open in new window

0
 
LVL 7

Author Comment

by:brettkm
ID: 33518207
Wow that was quick, thanks.

Got the error below.  This is where the script stopped last time, so I'm guessing the 31 character limit didn't work.

---------------------------
Windows Script Host
---------------------------
Script:      \test.vbs
Line:      52
Char:      2
Error:      Cannot rename a sheet to the same name as another sheet, a referenced object library or a workbook referenced by Visual Basic.
Code:      800A03EC
Source:       Microsoft Office Excel

0
 
LVL 65

Expert Comment

by:RobSampson
ID: 33518230
Are you querying two groups with the same name? Or at least the same first 31 characters?

Try this code....it will tell you when a group has the same name as an existing sheet.

Regards,

Rob.
Option Explicit

Dim adoCommand, adoConnection, strBase, strFilter, strAttributes
Dim objRootDSE, strDNSDomain, strQuery, adoRecordset, strName,groupType,groupName,iRow
Dim objExcel,arrMembers, strMember

' Setup ADO objects.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection

' Search entire Active Directory domain.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strBase = "<LDAP://" & strDNSDomain & ">"

' Filter on distribution groups.
strFilter = "(objectCategory=group)"

' Comma delimited list of attribute values to retrieve.
strAttributes = "distinguishedName,member,groupType,name"

' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False

' Run the query.
Set adoRecordset = adoCommand.Execute

Set objExcel = CreateObject("Excel.Application")
With objExcel
.SheetsInNewWorkbook = 1
.Workbooks.Add
.Visible = True

' Enumerate the resulting recordset.
Do Until adoRecordset.EOF
' Retrieve values and display.
strName = adoRecordset.Fields("distinguishedName").Value
groupType  = adoRecordset.Fields("groupType").Value
groupName  = Replace(adoRecordset.Fields("name").Value,"CN=", "")

'get only distribution groups
if groupType=2 or groupType=4 or groupType=8 then
	irow=1
	.ActiveWorkbook.Worksheets.Add
	On Error Resume Next
	.ActiveSheet.Name= Left(groupName, 31)
	If Err.Number <> 0 Then
		MsgBox "A sheet named " & Left(groupName, 31) & " already exists.  Cannot create sheet."
		Err.Clear
		On Error GoTo 0
	Else
		On Error GoTo 0
		arrMembers = adoRecordset.Fields("member").Value
	
		'Wscript.Echo "Distribution Group: " & strName
		If IsNull(arrMembers) Then
			'Wscript.Echo "-- <No Members>"
		Else
			For Each strMember In arrMembers
				'Wscript.Echo "-- " & strMember
				Set objRootDSE = GetObject("LDAP://"&strMember)
				.Cells(iRow,1) = Replace(objRootDSE.Name,"CN=", "")
				irow=irow + 1
			Next
		End If
	End If
End If
' Move to the next record in the recordset.
adoRecordset.MoveNext
Loop
.Columns(1).entirecolumn.autofit
End With

' Clean up.
adoRecordset.Close
adoConnection.Close
Set objExcel = Nothing

Open in new window

0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 7

Author Comment

by:brettkm
ID: 33518252
Yes you're right, the first 31 characters of some groups are the same.  There isn't many groups like this so I can do these manually if needs be.  It looks like when the script comes across this problem it just creates a blank worksheet, this is fine.

It seems to be missing some groups though, does it export mail enabled security groups?   Is there a better way of doing this?  Maybe an LDAP query of an OU instead?
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 33518280
This is performing an LDAP query of every group in your domain, and only creating sheets for "distribution" groups, so security groups won't be shown.  If you want to show those, comment out lines 49 and 74 in the above code snippet.

Regards,

Rob.
0
 
LVL 7

Author Comment

by:brettkm
ID: 33518319
Very sorry, I should've said I wasn't after every group, just members of a certain OU.  I thought it would've been easier to answer seeing as though I already had most of the script.  I don't need the members of every group exported, is it easy enough to tweak this script to query an OU?

0
 
LVL 65

Expert Comment

by:RobSampson
ID: 33518359
Sure, change this line:
strBase = "<LDAP://" & strDNSDomain & ">"

to this

strOU = "OU=MyOU,OU=NextOU,"
strBase = "<LDAP://" & strOU & strDNSDomain & ">"

When you list the OU order, it must be in reverse.  The domain name is automatically pulled with strDNSDomain, and the above strOU referes to
domain.com/NextOU/MyOU

so you can see that the OUs are listed in reverse.

With those two lines instead of the original one, only one OU (and it's subOUs) will be queried.

Regards,

Rob.
0
 
LVL 7

Author Comment

by:brettkm
ID: 33518376
What's the format of MyOU,OU=NextOU etcc..?  Is it possible to just use the OU DN?
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 33518396
Yes, it *is* the OU distinguished Name, but without the DC=domain,DC=com bits....that's in strDNSDomain.

Regards,

Rob.
0
 
LVL 7

Author Comment

by:brettkm
ID: 33518470
OK gotcha. get the error below now:

Script:      \test.vbs
Line:      17
Char:      1
Error:      Variable is undefined: 'strOU'
Code:      800A01F4
Source:       Microsoft VBScript runtime error

I have this at line 17 and 18 at the moment.  I've tried swapping staff and security distribution groups around just in case with no luck.

strOU = "OU=Security Distribution Groups,OU=STAFF"
strBase = "<LDAP://" & strOU & strDNSDomain & ">"

The full DN is OU=Security Distribution Groups,OU=STAFF,DC=local,DC=domain,DC=com

These could be the hardest points you earn my friend ;)  Feel free to stop at any time.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 33518484
Ha ha, no problem.  We'll get there....you haven't seen some of my other posts.....this one's easy by comparison ;-)

So variable undefined just means you need to add

Dim strOU

above those two lines.

strOU should then be
strOU = "OU=Security Distribution Groups,OU=STAFF,"

Regards,

Rob.
0
 
LVL 7

Author Closing Comment

by:brettkm
ID: 33518530
Worked a treat, thanks very much for your efforts.
0
 
LVL 7

Author Comment

by:brettkm
ID: 33518556
Forgot to ask, is there anyway for the worksheets to be in alphabetical order from sheet1 onwards?  At the moment there's no real order than I can work out.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 33518621
Try this.  I haven't tested it, but I've taken the code from here:

http://randombroad.wordpress.com/2006/08/11/how-to-sort-sheets-in-excel/

Regards,

Rob.
Option Explicit

Dim adoCommand, adoConnection, strBase, strFilter, strAttributes
Dim objRootDSE, strDNSDomain, strQuery, adoRecordset, strName,groupType,groupName,iRow, strOU
Dim objExcel,arrMembers, strMember

' Setup ADO objects.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection

' Search entire Active Directory domain.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strOU = "OU=MyOU,OU=NextOU,"
strBase = "<LDAP://" & strOU & strDNSDomain & ">"

' Filter on distribution groups.
strFilter = "(objectCategory=group)"

' Comma delimited list of attribute values to retrieve.
strAttributes = "distinguishedName,member,groupType,name"

' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False

' Run the query.
Set adoRecordset = adoCommand.Execute

Set objExcel = CreateObject("Excel.Application")
With objExcel
.SheetsInNewWorkbook = 1
.Workbooks.Add
.Visible = True

' Enumerate the resulting recordset.
Do Until adoRecordset.EOF
' Retrieve values and display.
strName = adoRecordset.Fields("distinguishedName").Value
groupType  = adoRecordset.Fields("groupType").Value
groupName  = Replace(adoRecordset.Fields("name").Value,"CN=", "")

'get only distribution groups
if groupType=2 or groupType=4 or groupType=8 then
	irow=1
	.ActiveWorkbook.Worksheets.Add
	On Error Resume Next
	.ActiveSheet.Name= Left(groupName, 31)
	If Err.Number <> 0 Then
		MsgBox "A sheet named " & Left(groupName, 31) & " already exists.  Cannot create sheet."
		Err.Clear
		On Error GoTo 0
	Else
		On Error GoTo 0
		arrMembers = adoRecordset.Fields("member").Value
	
		'Wscript.Echo "Distribution Group: " & strName
		If IsNull(arrMembers) Then
			'Wscript.Echo "-- <No Members>"
		Else
			For Each strMember In arrMembers
				'Wscript.Echo "-- " & strMember
				Set objRootDSE = GetObject("LDAP://"&strMember)
				.Cells(iRow,1) = Replace(objRootDSE.Name,"CN=", "")
				irow=irow + 1
			Next
		End If
	End If
End If
' Move to the next record in the recordset.
adoRecordset.MoveNext
Loop
.Columns(1).entirecolumn.autofit
End With

' Clean up.
adoRecordset.Close
adoConnection.Close
Sort_Active_Book
Set objExcel = Nothing

Sub Sort_Active_Book()
Dim i
Dim j
Dim iAnswer
'
' Prompt the user as which direction they wish to
' sort the worksheets.
'
   iAnswer = MsgBox("Sort Sheets in Ascending Order?" & Chr(10) _
     & "Clicking No will sort in Descending Order", _
     vbYesNoCancel + vbQuestion + vbDefaultButton1, "Sort Worksheets")
   For i = 1 To objExcel.ActiveWorkbook.Sheets.Count
      For j = 1 To objExcel.ActiveWorkbook.Sheets.Count - 1
'
' If the answer is Yes, then sort in ascending order.
'
         If iAnswer = vbYes Then
            If UCase(objExcel.ActiveWorkbook.Sheets(j).Name) > UCase(objExcel.ActiveWorkbook.Sheets(j + 1).Name) Then
               objExcel.ActiveWorkbook.Sheets(j).Move ,objExcel.ActiveWorkbook.Sheets(j + 1)
            End If
'
' If the answer is No, then sort in descending order.
'
         ElseIf iAnswer = vbNo Then
            If UCase(objExcel.ActiveWorkbook.Sheets(j).Name) < UCase(objExcel.ActiveWorkbook.Sheets(j + 1).Name) Then
               objExcel.ActiveWorkbook.Sheets(j).Move ,objExcel.ActiveWorkbook.Sheets(j + 1)
            End If
         End If
      Next
   Next
End Sub

Open in new window

0

Featured Post

NEW Veeam Agent for Microsoft Windows

Backup and recover physical and cloud-based servers and workstations, as well as endpoint devices that belong to remote users. Avoid downtime and data loss quickly and easily for Windows-based physical or public cloud-based workloads!

Question has a verified solution.

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

Suggested Solutions

In-place Upgrading Dirsync to Azure AD Connect
This article describes my battle tested process for setting up delegation. I use this process anywhere that I need to setup delegation. In the article I will show how it applies to Active Directory
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

679 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