?
Solved

VBScript to export members of Groups and export to Excel

Posted on 2010-08-24
14
Medium Priority
?
2,188 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 7
  • 7
14 Comments
 
LVL 65

Accepted Solution

by:
RobSampson earned 2000 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
Are your AD admin tools letting you down?

Managing Active Directory can get complicated.  Often, the native tools for managing AD are just not up to the task.  The largest Active Directory installations in the world have relied on one tool to manage their day-to-day administration tasks: Hyena. Start your trial today.

 
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

On Demand Webinar: Networking for the Cloud Era

Ready to improve network connectivity? Watch this webinar to learn how SD-WANs and a one-click instant connect tool can boost provisions, deployment, and management of your cloud connection.

Question has a verified solution.

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

Here's a look at newsworthy articles and community happenings during the last month.
After seeing numerous questions for Dynamic Data Validation I notice that most have used Visual Basic to solve the problem. This suggestion is purely formula based and can be used in multiple rows.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.
Sometimes it takes a new vantage point, apart from our everyday security practices, to truly see our Active Directory (AD) vulnerabilities. We get used to implementing the same techniques and checking the same areas for a breach. This pattern can re…
Suggested Courses

752 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