[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2283
  • Last Modified:

VBScript to export members of Groups and export to Excel

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
brettkm
Asked:
brettkm
  • 7
  • 7
1 Solution
 
RobSampsonCommented:
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
 
brettkmAuthor Commented:
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
 
RobSampsonCommented:
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
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
brettkmAuthor Commented:
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
 
RobSampsonCommented:
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
 
brettkmAuthor Commented:
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
 
RobSampsonCommented:
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
 
brettkmAuthor Commented:
What's the format of MyOU,OU=NextOU etcc..?  Is it possible to just use the OU DN?
0
 
RobSampsonCommented:
Yes, it *is* the OU distinguished Name, but without the DC=domain,DC=com bits....that's in strDNSDomain.

Regards,

Rob.
0
 
brettkmAuthor Commented:
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
 
RobSampsonCommented:
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
 
brettkmAuthor Commented:
Worked a treat, thanks very much for your efforts.
0
 
brettkmAuthor Commented:
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
 
RobSampsonCommented:
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

Get free NFR key for Veeam Availability Suite 9.5

Veeam is happy to provide a free NFR license (1 year, 2 sockets) to all certified IT Pros. The license allows for the non-production use of Veeam Availability Suite v9.5 in your home lab, without any feature limitations. It works for both VMware and Hyper-V environments

  • 7
  • 7
Tackle projects and never again get stuck behind a technical roadblock.
Join Now