Solved

VBScript to export members of Groups and export to Excel

Posted on 2010-08-24
14
2,033 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
 
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

Join & Write a Comment

Disabling the Directory Sync Service Account in Office 365 will stop directory synchronization from working.
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…

743 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now