Question

need a report on how to retrieve OU Structucture and select which OU

Asked by: eperez0968

Hi guys,
i need to be able to have an HTML report based on my selection on which OU i select. it needs to enumerate the Domian Structure and i should be able to select the top level ou's to report per OU, this report should be seperated per Top level OU's selcted ( what i mena about top level ou if the OU has OU's with that main OU)

1. the count of users per OU
2. the count of Computers per OU
3. the count of Groups per OU
4. the Count of Disabled users per OU
5. Users and Groups that are e-mailed enabled

at the end of this HTML report needs to tally the report per ou selected from.
this code below is from this site but it is very generic, can someone please help and modify this HTA script to be able to do the tasks and maybe be able to out put the report in multiple formats, HTML, excel, doc, csv, by selecting what format

This Question has been solved and asker verified All Experts Exchange premium technology solutions are available to subscription members.

Subscribe now for full access to Experts Exchange and get

Instant Access to this Solution

Plus...

30 Day FREE access, no risk, no obligation
Collaborate with the world's top tech experts
Unlimited access to our exclusive solution database
Never be left without tech help again

Subscribe Now

Asked On: 2009-10-14 at 07:50:38ID24811403
Tags: Microsoft
,; VB Script
,; LDAP Que
Topics: Microsoft Server
,; Miscellaneous Programming
,; Kernel And Operating System Specific Programming
,; Hypertext Markup Language (HTML)
,; VB Script
Participating Experts: 2
Points: 500
Comments: 36

Trusted by hundreds of thousands everyday for fast, accurate and reliable tech support.

"The time we save is the biggest benefit of Experts Exchange to Warner Bros. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange." Mike Kapnisakis, Warner Bros.
"Our team likes having a resource that is more secure than just using Google and most experts using this service really know their stuff. It's nice to look here first versus using Google." Dayna Sellner, Lockheed Martin
"Anytime that I've been stumped with a problem, 9 out of 10 times Experts Exchange has either the accepted solution or an open discussion of the potential solution to the problem." Kenny Red, eBay Inc.

See what Experts Exchange can do for you.

Got a question?

We've got the answer.

Experts Exchange has been collecting answers to technology questions since 1996…3 million and counting! If you have a question, chances are we already have your answer.

Screenshot of Experts Exchange Knowledgebase

Need individual assistance?

Our experts are ready to help.

If you can't find the exact answer you're looking for, ask our exclusive community of 50,000 experts. You’ll get a personalized answer from a trusted professional.

Want to learn from the best?

Read articles from industry experts.

Thousands of free tech tips, tricks, how-to’s and tutorials are available in our peer reviewed articles section. See for yourself how smart our experts are, no login required.

Working on a long term project?

Store your work and research.

Save solutions to your questions, answers you’ve discovered through searching plus helpful articles in your personal knowledgebase for easy future access.

Access the answers to your technology questions today.

Subscribe Now

30-day free trial. Register in 60 seconds.

What Makes Experts Exchange Unique?

Members of the expert community talk about why the experience at Experts Exchange is different than what you will find anywhere else.

Trusted by the world's most respected brands.

image of each brand's logo

Faithfully serving IT professionals since 1996.

Experts Exchange Logo

Try it out and discover for yourself.

Subscribe Now

30-day free trial. Register in 60 seconds.

Free Tech Articles

WARNING: 5 Reasons why you should NEVER fix a computer for free.
It is in our nature to love the puzzle. We are obsessed. The lot of us. We love puzzles. We love the challenge. We thrive on finding the answer. We hate disarray. It bothers us deep in our soul. W...
SCCM OSD Basic troubleshooting
SCCM 2007 OSD is a fantastic way to deploy operating systems, however, like most things SCCM issues can sometimes be difficult to resolve due to the sheer volume of logs to sift through and the dispe...
Migrate Small Business Server 2003 to Exchange 2010 and Windows 2008 R2
This guide is intended to provide step by step instructions on how to migrate from Small Business Server 2003 to Windows 2008 R2 with Exchange 2010. For this migration to work you will need the fo...
Create a Win7 Gadget
This article shows you how to create a simple "Gadget" -- a sort of mini-application supported by Windows 7 and Vista. Gadgets can be dropped anywhere on the desktop to provide instant information, ...
Outlook continually prompting for username and password
There have been a lot of questions recently regarding Outlook prompting for a username and password whilst using Exchange 2007. There are a few reasons why this would happen and I will try to cover t...
Backup Exchange 2010 Information Store using Windows Backup
There seems to be quite a lot of confusion around the ability to backup Exchange 2010 using the built in Windows Backup feature. This stems from the omission of this feature prior to Exchange 2007 s...

Cloud Class Webinars

Avoiding Bugs in Microsoft Access
Alison Balter takes and in-depth look at avoiding bugs in Access. In this webinar you will learn about using the immediate window to debug your applications, invoking the debugger, using breakpoints to troubleshoot, stepping through code, setting the next statement to execute, ...
Top 10 Best New Features in Visio 2010
Scott Helmers gives live demonstrations of the top 10 new features in Visio 2010. This webinar will teach you how to create compelling diagrams by adding shapes to the page with a single click, linking the shapes in a diagram to data in Excel (or SQL Server, or SharePoint), ...
IT Consultant Business Secrets Revealed
Michael Munger, Experts Exchange tech pro and IT consultant, pulls back the curtain on his very successful businesses and answers question on every IT consultant and business owner should know about. He shares secrets on what he did to solve the 5 most common problems in IT, ...
Disaster Recovery and Business Continuity
Quest CTO, Mike Billon, gives an overview of the steps involved in building a dunamic disaster recovery plan. Through case studies and an examination of software/hardware tooles for monitoring and testing, you'll gain a better understandin of where you are, where you want ...
Organize Your Visio Diagrams with Containers and Lists
Scott Helmers uses cross functional flowcharts, wireframe diagrams, data graphic legends and seating charts to teach you: how to ustilize all three new structured diagram components in Visio 2010, the best practices for organizeing shapes in previous version of Visio, how to organize ...
How to Us Objects, Properties, Events and Methods in Microsoft Access
Alison Dalter gives an in-depbth look at objects, properties, events and methods in Microsoft Access. In this webinar you will learn about using the object browser, referring to objects, working with properties and methods, working with object variables, understanding the ...

Watch More

Join the Community

Give a Little. Get a Lot.

Join the community of experts here and help other tech pros by answering question in your area of expertise. You can earn FREE access to all Experts Exchange's premium features and resources.

Join the Community

Answers

by: RobSampsonPosted on 2009-11-04 at 17:22:15ID: 25745952

Hi there,

This seems complicated but should be achievable eventually.

First off though, you didn't post the other code that you found here on EE. Can you post where that is so we can start with that?

Regards,

Rob.

by: eperez0968Posted on 2009-11-05 at 18:40:58ID: 25756223

i could not find the HTA script that i have located before, but to make it simple i have seen a hta report that would query the domain, then it would list all the OU's in a box and from there you would be able to select which OU and it would display the users and computers in the OU.
i am looking for the same were it would do the same but in addition, it would also have a button were you have a choice to output the results in nice formated HTML, excel sheet, DOC file. it would show all users, computers and groups
at the top or bottom of the report it would tally all the users, computers, groups and e-mailed enabled users, groups.

maybe this is a little to much, please let me know

by: RobSampsonPosted on 2009-11-05 at 20:08:20ID: 25756550

Hmmm, that HTA sounds similar to one that I built a while back....I'll look for it...

Rob.

by: RobSampsonPosted on 2009-11-05 at 20:23:04ID: 25756602

Hi, this may have been it:
http://www.experts-exchange.com/Software/Server_Software/File_Servers/Active_Directory/Q_23863991.html

I will work on extending it a bit.

Regards,

Rob.

by: RobSampsonPosted on 2009-11-05 at 20:48:57ID: 25756677

How's this for a start?

From here, what sort of report format would you want?

Regards,

Rob.

<Html>
<Head>
<Title>List OU Users, Computers, and Groups</Title>
 
<HTA:Application
Caption = Yes
Border = Thick
ShowInTaskBar = Yes
SingleInstance = Yes
MaximizeButton = Yes
MinimizeButton = Yes>
 
<script Language = VBScript>
 
	Sub Window_OnLoad
		intWidth = 800
		intHeight = 600
		Me.ResizeTo intWidth, intHeight
		Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
		lst_users.Style.Width = 200
		lst_computers.Style.Width = 200
		lst_groups.Style.Width = 200
    	Set objRootDSE = GetObject("LDAP://RootDSE")
    	strBaseConnString = objRootDSE.Get("defaultNamingContext")
		Set objOULevel = GetObject("LDAP://" & strBaseConnString)
		RecurseOUs objOULevel, 0, strBaseConnString
		Show_Selection
	End Sub
 
	Sub Clear_Users
		For intListProgress = 1 To lst_Users.Length
	   		lst_Users.Remove 0
	   	Next
	   	span_totalusers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_Computers
		For intListProgress = 1 To lst_computers.Length
	   		lst_computers.Remove 0
	   	Next
	   	span_totalcomputers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_Groups
		For intListProgress = 1 To lst_groups.Length
	   		lst_groups.Remove 0
	   	Next
	   	span_totalgroups.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub RecurseOUs(objOU, intLevel, strBaseConn)
		Dim objOUObject, strConnString, objActiveOption
		For Each objOUObject In objOU
			If UCase(Left(objOUObject.Name, 3)) = "OU=" Then
				strConnString = objOUObject.DistinguishedName
				Set objActiveOption = Document.CreateElement("OPTION")
		    	If intLevel = 0 Then
		    		objActiveOption.Text = Replace(objOUObject.Name, "OU=", "")
		    	Else
		    		objActiveOption.Text = String(intLevel * 4, " ") & "->   " & Replace(objOUObject.Name, "OU=", "")
		    	End If
		    	objActiveOption.Value = strConnString
		    	lst_SiteFilter.Add objActiveOption
				On Error Resume Next
				RecurseOUs GetObject("LDAP://" & strConnString), intLevel + 1, strBaseConn
				If Err.Number <> 0 Then
					MsgBox "Error enumerating " & strConnString
				End If
				Err.Clear
				On Error GoTo 0
			End If
		Next
	End Sub
 
	Sub Show_Selection
		span_SiteFilter.InnerHTML = lst_SiteFilter.Value
	End Sub
 
	Sub Default_Buttons
		If Window.Event.KeyCode = 13 Then
			btn_run.Click
		End If
	End Sub
 
	Sub Exit_HTA
		Window.Close
	End Sub
 
	Sub Get_Members
		Clear_Users
		Clear_Computers
		Clear_Groups
		strOU = lst_sitefilter.Value
		strLDAPPath = "LDAP://" & strOU
		
		Set objConnection2 = CreateObject("ADODB.Connection")
		Set objCommand2 = CreateObject("ADODB.Command")
		objConnection2.Provider = "ADsDSOObject"
		objConnection2.Open "Active Directory Provider"
		Set objCommand2.ActiveConnection = objConnection2
		
		Set objOU = GetObject(strLDAPPath)
		For Each objObject In objOU
			Set objMember = Document.CreateElement("OPTION")
			objMember.Text = objObject.cn
	        objMember.Value = objObject.cn
			If LCase(objObject.Class) = "user" Then
				lst_users.Add objMember, 0
			ElseIf LCase(objObject.Class) = "computer" Then
				lst_computers.Add objMember, 0
			ElseIf LCase(objObject.Class) = "group" Then
				lst_groups.Add objMember, 0
			End If
		Next
		span_totalusers.InnerHTML = "<b>" & lst_users.Length & "</b>"
		span_totalcomputers.InnerHTML = "<b>" & lst_computers.Length & "</b>"
		span_totalgroups.InnerHTML = "<b>" & lst_groups.Length & "</b>"
	End Sub
</script>
<body style="background-color:#B0C4DE;" onkeypress='vbs:Default_Buttons'>
	<table height="90%" width= "90%" border="0" align="center">
		<tr>
			<td align="center" colspan="3">
				<h2>List OU Users, Computers, and Groups</h2>
			</td>
		</tr>
		<tr>
			<td>
				<b>Site Filter:</b>
			</td>
			<td>
			    <select size='1' name='lst_SiteFilter'  onChange='vbs:Show_Selection'>
				</select>
			<td>
				<button name="btn_run" id="btn_run" accessKey="G" onclick="vbs:Get_Members"><u>G</u>et Members</button>
			</td>
		</tr>
		<tr>
			<td colspan=3>
				<b>Site Selected:</b>&nbsp&nbsp&nbsp<span id='span_SiteFilter'></span>
			</td>
		</tr>
		<tr>
			<td>
				<b>Users:</b><br>
			    <select size='8' name='lst_users'>
				</select>
				<br><b>Total: </b><span id="span_totalusers"></span>
			</td>
			<td>
				<b>Computers:</b><br>
			    <select size='8' name='lst_computers'>
				</select>
				<br><b>Total: </b><span id="span_totalcomputers"></span>
			</td>
			<td>
				<b>Groups:</b><br>
			    <select size='8' name='lst_groups'>
				</select>
				<br><b>Total: </b><span id="span_totalgroups"></span>
			</td>
		</tr>
	</table>
	<table width= "90%" border="0" align="center">
		<tr align="center">
 
			<td>
				<button name="btn_exit" id="btn_exit" accessKey="x" onclick="vbs:Exit_HTA">E<u>x</u>it</button>
			</td>
		</tr>
	</table>
</body>
</head>
</html>

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:

Select all Open in new window

by: eperez0968Posted on 2009-11-06 at 06:22:14ID: 25759293

WOW this is great!!! :) i love it

i have attached an example of the output should look like. Few changes i hope you can understand what i am trying to get at with the spread sheet i have attached.

1. be able to select multiple OU's
2. if i select an ou and it has sub ou's it will show this in the report aswell
3. last request if possible to be able to send auto mated reports or manually through e-mail to a specific user or group, some type of input or pop up box i guess (if this can take too long dont worry i will send it manually)

OUReport-11-06-2009.xlsx
- 10 KB
OUReport xlsx format
OUReport-11-06-2009.xls
- 21 KB
OUReport xls format

by: eperez0968Posted on 2009-11-06 at 06:31:01ID: 25759365

just in case you missed it, the reports are dated to the date it was ran

by: RobSampsonPosted on 2009-11-06 at 18:32:00ID: 25764739

OK, I'll take a look at getting the extra info before we output to a report. I can't test the mail-enabled bit, because I don't use Exchange, but I think I know to check for it.

I can start this on Monday.

Regards,

Rob.

by: eperez0968Posted on 2009-11-07 at 03:49:10ID: 25765911

Rob Thanks,

I appreciate this very much
thanks again
Eric

by: RobSampsonPosted on 2009-11-08 at 20:44:20ID: 25773447

Hi, I was sitting here coding away, when I was trying to think of the logic of things, and have realised a catch. I'm testing if a user is disabled or enabled, which is fine, and putting them into the Enabled or Disabled box. But, you also wanted mail enabled or not, so I was going to put mail enabled people in their own box, but to avoid duplicates, I would pull them out of the enabled or disabled box. This means though, that for a mail-enabled user, you don't know whether the account is disabled or not.

What are your thoughts on that?

Also, the Export currently only works when a single OU is selected. To be able to count multiple OU's correctly, and display their counts, I think the code will need a rewrite in how the totals are recorded, but that' should take too much longer.....

Regards,

Rob.

<Html>
<Head>
<Title>List OU Users, Computers, and Groups</Title>
 
<HTA:Application
Caption = Yes
Border = Thick
ShowInTaskBar = Yes
SingleInstance = Yes
MaximizeButton = Yes
MinimizeButton = Yes>
 
<script Language = VBScript>
 
	Sub Window_OnLoad
		intWidth = 800
		intHeight = 800
		Me.ResizeTo intWidth, intHeight
		Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
		lst_users.Style.Width = 200
		lst_computers.Style.Width = 200
		lst_groups.Style.Width = 200
		lst_mailenabledusers.Style.Width = 200
		lst_mailenabledgroups.Style.Width = 200
		lst_disabledusers.Style.Width = 200
		lst_disabledcomputers.Style.Width = 200
    	Set objRootDSE = GetObject("LDAP://RootDSE")
    	strBaseConnString = objRootDSE.Get("defaultNamingContext")
		Set objOULevel = GetObject("LDAP://" & strBaseConnString)
		RecurseOUs objOULevel, 0, strBaseConnString
		Show_Selection
	End Sub
 
	Sub Clear_Users
		For intListProgress = 1 To lst_Users.Length
	   		lst_Users.Remove 0
	   	Next
	   	span_totalusers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_Computers
		For intListProgress = 1 To lst_computers.Length
	   		lst_computers.Remove 0
	   	Next
	   	span_totalcomputers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_Groups
		For intListProgress = 1 To lst_groups.Length
	   		lst_groups.Remove 0
	   	Next
	   	span_totalgroups.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_MailEnabledUsers
		For intListProgress = 1 To lst_mailenabledusers.Length
	   		lst_mailenabledusers.Remove 0
	   	Next
	   	span_totalmailusers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_MailEnabledGroups
		For intListProgress = 1 To lst_mailenabledgroups.Length
	   		lst_mailenabledgroups.Remove 0
	   	Next
	   	span_totalmailgroups.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_DisabledUsers
		For intListProgress = 1 To lst_disabledusers.Length
	   		lst_disabledusers.Remove 0
	   	Next
	   	span_totaldisabledusers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_DisabledComputers
		For intListProgress = 1 To lst_disabledcomputers.Length
	   		lst_disabledcomputers.Remove 0
	   	Next
	   	span_totaldisabledcomputers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub RecurseOUs(objOU, intLevel, strBaseConn)
		Dim objOUObject, strConnString, objActiveOption
		For Each objOUObject In objOU
			If UCase(Left(objOUObject.Name, 3)) = "OU=" Then
				strConnString = objOUObject.DistinguishedName
				Set objActiveOption = Document.CreateElement("OPTION")
		    	If intLevel = 0 Then
		    		objActiveOption.Text = Replace(objOUObject.Name, "OU=", "")
		    	Else
		    		objActiveOption.Text = String(intLevel * 4, " ") & "->   " & Replace(objOUObject.Name, "OU=", "")
		    	End If
		    	objActiveOption.Value = strConnString
		    	lst_SiteFilter.Add objActiveOption
				On Error Resume Next
				RecurseOUs GetObject("LDAP://" & strConnString), intLevel + 1, strBaseConn
				If Err.Number <> 0 Then
					MsgBox "Error enumerating " & strConnString
				End If
				Err.Clear
				On Error GoTo 0
			End If
		Next
	End Sub
 
	Sub Show_Selection
		span_SiteFilter.InnerHTML = ""
		For Each objOption In lst_SiteFilter.Options
			If objOption.Selected = True Then
				If span_SiteFilter.InnerHTML = "" Then
					span_SiteFilter.InnerHTML = objOption.Value
				Else
					span_SiteFilter.InnerHTML = span_SiteFilter.InnerHTML & "<BR>" & objOption.Value
				End If
			End If
		Next
	End Sub
 
	Sub Default_Buttons
		If Window.Event.KeyCode = 13 Then
			btn_run.Click
		End If
	End Sub
 
	Sub Exit_HTA
		Window.Close
	End Sub
 
	Sub Get_Members
		Clear_Users
		Clear_Computers
		Clear_Groups
		Clear_MailEnabledUsers
		Clear_MailEnabledGroups
		Clear_DisabledUsers
		Clear_DisabledComputers
		
		Set objConnection2 = CreateObject("ADODB.Connection")
		Set objCommand2 = CreateObject("ADODB.Command")
		objConnection2.Provider = "ADsDSOObject"
		objConnection2.Open "Active Directory Provider"
		Set objCommand2.ActiveConnection = objConnection2
		
		For Each strOU In Split(span_sitefilter.InnerHTML, "<BR>")
			GetOUObjects("LDAP://" & strOU)
		Next
		
		span_totalusers.InnerHTML = "<b>" & lst_users.Length & "</b>"
		span_totalcomputers.InnerHTML = "<b>" & lst_computers.Length & "</b>"
		span_totalgroups.InnerHTML = "<b>" & lst_groups.Length & "</b>"
		span_totalmailusers.InnerHTML = "<b>" & lst_mailenabledusers.Length & "</b>"
		span_totalmailgroups.InnerHTML = "<b>" & lst_mailenabledgroups.Length & "</b>"
		span_totaldisabledusers.InnerHTML = "<b>" & lst_disabledusers.Length & "</b>"
		span_totaldisabledcomputers.InnerHTML = "<b>" & lst_disabledcomputers.Length & "</b>"
	End Sub
	
	Sub GetOUObjects(strLDAPPath)
		Const ADS_UF_ACCOUNTDISABLE = 2
		Set objOU = GetObject(strLDAPPath)
		For Each objObject In objOU
			Set objMember = Document.CreateElement("OPTION")
			objMember.Text = objObject.cn
	        objMember.Value = objObject.distinguishedname
			If LCase(objObject.Class) = "user" Then
				intUAC = objObject.userAccountControl
				If intUAC And ADS_UF_ACCOUNTDISABLE Then
					lst_disabledusers.Add objMember, 0
				Else
					lst_users.Add objMember, 0
				End If
			ElseIf LCase(objObject.Class) = "computer" Then
				intUAC = objObject.userAccountControl
				If intUAC And ADS_UF_ACCOUNTDISABLE Then
					lst_disabledcomputers.Add objMember, 0
				Else
					lst_computers.Add objMember, 0
				End If
			ElseIf LCase(objObject.Class) = "group" Then
				lst_groups.Add objMember, 0
			End If
			If chk_recurse.checked = True Then
				GetOUObjects objObject.adsPath
			End If
		Next
	End Sub
	
	Sub Export_Excel
		Set objExcel = CreateObject("Excel.Application")
		Set objWB = objExcel.Workbooks.Add
		Set objSheet = objWB.Sheets(1)
		objExcel.Visible = True
		objSheet.Cells(1, 1).Value = "Report Date " & Date
		objSheet.Cells(1, 1).Font.Bold = True
		objSheet.Cells(2, 2).Value = "Users"
		objSheet.Cells(2, 3).Value = "Computers"
		objSheet.Cells(2, 4).Value = "Groups"
		objSheet.Cells(2, 5).Value = "Mail-Enabled Users"
		objSheet.Cells(2, 6).Value = "Mail-Enabled Groups"
		objSheet.Cells(2, 7).Value = "Disabled Users"
		objSheet.Cells(2, 8).Value = "Disabled Computers"
		objSheet.Rows("2:2").Font.Bold = True
		objSheet.Cells(3, 1).Value = "OU with Sub OU's if they exist"
		objSheet.Cells(3, 1).Font.ColorIndex = 55
		objSheet.Cells(3, 1).Font.Bold = True
		intRow = 4
		For Each strOU In Split(span_sitefilter.InnerHTML, "<BR>")
			objSheet.Cells(intRow, 1).Value = strOU
			For intCol = 2 To 8
				objSheet.Cells(intRow, intCol).Value = 0
			Next
			' Users
			For Each objEntry In lst_Users.Options
				If InStr(LCase(objEntry.Value), LCase(strOU)) > 0 Then
					objSheet.Cells(intRow, 2).Value = objSheet.Cells(intRow, 2).Value + 1
				End If
			Next
			' Computers
			For Each objEntry In lst_Computers.Options
				If InStr(LCase(objEntry.Value), LCase(strOU)) > 0 Then
					objSheet.Cells(intRow, 3).Value = objSheet.Cells(intRow, 3).Value + 1
				End If
			Next
			' Groups
			For Each objEntry In lst_groups.Options
				If InStr(LCase(objEntry.Value), LCase(strOU)) > 0 Then
					objSheet.Cells(intRow, 4).Value = objSheet.Cells(intRow, 4).Value + 1
				End If
			Next
			' Mail-Enabled Users
			For Each objEntry In lst_mailenabledusers.Options
				If InStr(LCase(objEntry.Value), LCase(strOU)) > 0 Then
					objSheet.Cells(intRow, 5).Value = objSheet.Cells(intRow, 5).Value + 1
				End If
			Next
			' Mail-Enabled Groups
			For Each objEntry In lst_mailenabledgroups.Options
				If InStr(LCase(objEntry.Value), LCase(strOU)) > 0 Then
					objSheet.Cells(intRow, 6).Value = objSheet.Cells(intRow, 6).Value + 1
				End If
			Next
			' Disabled Users
			For Each objEntry In lst_disabledusers.Options
				If InStr(LCase(objEntry.Value), LCase(strOU)) > 0 Then
					objSheet.Cells(intRow, 7).Value = objSheet.Cells(intRow, 7).Value + 1
				End If
			Next
			' Disabled Computers
			For Each objEntry In lst_disabledcomputers.Options
				If InStr(LCase(objEntry.Value), LCase(strOU)) > 0 Then
					objSheet.Cells(intRow, 8).Value = objSheet.Cells(intRow, 8).Value + 1
				End If
			Next
			intRow = intRow + 1
		Next
	objSheet.Columns.AutoFit
	End Sub
</script>
<body style="background-color:#B0C4DE;" onkeypress='vbs:Default_Buttons'>
	<table height="90%" width= "90%" border="0" align="center">
		<tr>
			<td align="center" colspan="3">
				<h2>List OU Users, Computers, and Groups</h2>
			</td>
		</tr>
		<tr>
			<td>
				<b>Site Filter:</b><br>Select multiple OUs with<br>CTRL + Click
			</td>
			<td colspan="2">
			    <select size='8' name='lst_SiteFilter'  onChange='vbs:Show_Selection' multiple="True">
				</select>
			</td>
		</tr>
		<tr>
			<td>
				&nbsp;
			</td>
			<td>
				<input type="checkbox" id="chk_recurse" name="chk_recurse">Recurse Sub OUs
			</td>
			<td>
				<button name="btn_run" id="btn_run" accessKey="G" onclick="vbs:Get_Members"><u>G</u>et Members</button>
			</td>
		</tr>
		<tr>
			<td colspan=3>
				<b>OU Selected:</b>&nbsp&nbsp&nbsp<span id='span_SiteFilter'></span>
			</td>
		</tr>
		<tr>
			<td>
				<b>Users:</b><br>
			    <select size='4' name='lst_users'>
				</select>
				<br><b>Total: </b><span id="span_totalusers"></span>
			</td>
			<td>
				<b>Computers:</b><br>
			    <select size='4' name='lst_computers'>
				</select>
				<br><b>Total: </b><span id="span_totalcomputers"></span>
			</td>
			<td>
				<b>Groups:</b><br>
			    <select size='4' name='lst_groups'>
				</select>
				<br><b>Total: </b><span id="span_totalgroups"></span>
			</td>
		</tr>
		<tr>
			<td>
				<b>Mail-Enabled Users:</b><br>
			    <select size='4' name='lst_mailenabledusers'>
				</select>
				<br><b>Total: </b><span id="span_totalmailusers"></span>
			</td>
			<td>
				&nbsp;
			</td>
			<td>
				<b>Mail-Enabled Groups:</b><br>
			    <select size='4' name='lst_mailenabledgroups'>
				</select>
				<br><b>Total: </b><span id="span_totalmailgroups"></span>
			</td>
		</tr>
		<tr>
			<td>
				<b>Disabled Users:</b><br>
			    <select size='4' name='lst_disabledusers'>
				</select>
				<br><b>Total: </b><span id="span_totaldisabledusers"></span>
			</td>
			<td>
				<b>Disabled Computers:</b><br>
			    <select size='4' name='lst_disabledcomputers'>
				</select>
				<br><b>Total: </b><span id="span_totaldisabledcomputers"></span>
			</td>
			<td>
				&nbsp;
			</td>
		</tr>
	</table>
	<table width= "90%" border="0" align="center">
		<tr align="center">
			<td>
				<button name="btn_exportexcel" id="btn_exportexcel" accessKey="e" onclick="vbs:Export_Excel"><u>E</u>xport to Excel</button>
			</td>
		</tr>
		<tr align="center">
			<td>
				<button name="btn_exit" id="btn_exit" accessKey="x" onclick="vbs:Exit_HTA">E<u>x</u>it</button>
			</td>
		</tr>
	</table>
</body>
</head>
</html>

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:

Select all Open in new window

by: RobSampsonPosted on 2009-11-08 at 21:37:07ID: 25773586

OK, this is better, but to mail-enabled issue still needs to be addressed.

Regards,

Rob.

<Html>
<Head>
<Title>List OU Users, Computers, and Groups</Title>
 
<HTA:Application
Caption = Yes
Border = Thick
ShowInTaskBar = Yes
SingleInstance = Yes
MaximizeButton = Yes
MinimizeButton = Yes>
 
<script Language = VBScript>
 
	Sub Window_OnLoad
		intWidth = 800
		intHeight = 800
		Me.ResizeTo intWidth, intHeight
		Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
		lst_users.Style.Width = 200
		lst_computers.Style.Width = 200
		lst_groups.Style.Width = 200
		lst_mailenabledusers.Style.Width = 200
		lst_mailenabledgroups.Style.Width = 200
		lst_disabledusers.Style.Width = 200
		lst_disabledcomputers.Style.Width = 200
    	Set objRootDSE = GetObject("LDAP://RootDSE")
    	strBaseConnString = objRootDSE.Get("defaultNamingContext")
		Set objOULevel = GetObject("LDAP://" & strBaseConnString)
		RecurseOUs objOULevel, 0, strBaseConnString
		Show_Selection
	End Sub
 
	Sub Clear_Users
		For intListProgress = 1 To lst_Users.Length
	   		lst_Users.Remove 0
	   	Next
	   	span_totalusers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_Computers
		For intListProgress = 1 To lst_computers.Length
	   		lst_computers.Remove 0
	   	Next
	   	span_totalcomputers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_Groups
		For intListProgress = 1 To lst_groups.Length
	   		lst_groups.Remove 0
	   	Next
	   	span_totalgroups.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_MailEnabledUsers
		For intListProgress = 1 To lst_mailenabledusers.Length
	   		lst_mailenabledusers.Remove 0
	   	Next
	   	span_totalmailusers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_MailEnabledGroups
		For intListProgress = 1 To lst_mailenabledgroups.Length
	   		lst_mailenabledgroups.Remove 0
	   	Next
	   	span_totalmailgroups.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_DisabledUsers
		For intListProgress = 1 To lst_disabledusers.Length
	   		lst_disabledusers.Remove 0
	   	Next
	   	span_totaldisabledusers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_DisabledComputers
		For intListProgress = 1 To lst_disabledcomputers.Length
	   		lst_disabledcomputers.Remove 0
	   	Next
	   	span_totaldisabledcomputers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub RecurseOUs(objOU, intLevel, strBaseConn)
		Dim objOUObject, strConnString, objActiveOption
		For Each objOUObject In objOU
			If UCase(Left(objOUObject.Name, 3)) = "OU=" Then
				strConnString = objOUObject.DistinguishedName
				Set objActiveOption = Document.CreateElement("OPTION")
		    	If intLevel = 0 Then
		    		objActiveOption.Text = Replace(objOUObject.Name, "OU=", "")
		    	Else
		    		objActiveOption.Text = String(intLevel * 4, " ") & "->   " & Replace(objOUObject.Name, "OU=", "")
		    	End If
		    	objActiveOption.Value = strConnString
		    	lst_SiteFilter.Add objActiveOption
				On Error Resume Next
				RecurseOUs GetObject("LDAP://" & strConnString), intLevel + 1, strBaseConn
				If Err.Number <> 0 Then
					MsgBox "Error enumerating " & strConnString
				End If
				Err.Clear
				On Error GoTo 0
			End If
		Next
	End Sub
 
	Sub Show_Selection
		span_SiteFilter.InnerHTML = ""
		For Each objOption In lst_SiteFilter.Options
			If objOption.Selected = True Then
				If span_SiteFilter.InnerHTML = "" Then
					span_SiteFilter.InnerHTML = objOption.Value
				Else
					span_SiteFilter.InnerHTML = span_SiteFilter.InnerHTML & "<BR>" & objOption.Value
				End If
			End If
		Next
	End Sub
 
	Sub Default_Buttons
		If Window.Event.KeyCode = 13 Then
			btn_run.Click
		End If
	End Sub
 
	Sub Exit_HTA
		Window.Close
	End Sub
 
	Sub Get_Members
		Clear_Users
		Clear_Computers
		Clear_Groups
		Clear_MailEnabledUsers
		Clear_MailEnabledGroups
		Clear_DisabledUsers
		Clear_DisabledComputers
		
		Set objConnection2 = CreateObject("ADODB.Connection")
		Set objCommand2 = CreateObject("ADODB.Command")
		objConnection2.Provider = "ADsDSOObject"
		objConnection2.Open "Active Directory Provider"
		Set objCommand2.ActiveConnection = objConnection2
		
		For Each strOU In Split(span_sitefilter.InnerHTML, "<BR>")
			GetOUObjects("LDAP://" & strOU)
		Next
		
		span_totalusers.InnerHTML = "<b>" & lst_users.Length & "</b>"
		span_totalcomputers.InnerHTML = "<b>" & lst_computers.Length & "</b>"
		span_totalgroups.InnerHTML = "<b>" & lst_groups.Length & "</b>"
		span_totalmailusers.InnerHTML = "<b>" & lst_mailenabledusers.Length & "</b>"
		span_totalmailgroups.InnerHTML = "<b>" & lst_mailenabledgroups.Length & "</b>"
		span_totaldisabledusers.InnerHTML = "<b>" & lst_disabledusers.Length & "</b>"
		span_totaldisabledcomputers.InnerHTML = "<b>" & lst_disabledcomputers.Length & "</b>"
	End Sub
	
	Sub GetOUObjects(strLDAPPath)
		Const ADS_UF_ACCOUNTDISABLE = 2
		Set objOU = GetObject(strLDAPPath)
		For Each objObject In objOU
			Set objMember = Document.CreateElement("OPTION")
			objMember.Text = objObject.cn
	        objMember.Value = objObject.distinguishedname
			If LCase(objObject.Class) = "user" Then
				intUAC = objObject.userAccountControl
				If intUAC And ADS_UF_ACCOUNTDISABLE Then
					lst_disabledusers.Add objMember, 0
				Else
					lst_users.Add objMember, 0
				End If
			ElseIf LCase(objObject.Class) = "computer" Then
				intUAC = objObject.userAccountControl
				If intUAC And ADS_UF_ACCOUNTDISABLE Then
					lst_disabledcomputers.Add objMember, 0
				Else
					lst_computers.Add objMember, 0
				End If
			ElseIf LCase(objObject.Class) = "group" Then
				lst_groups.Add objMember, 0
			End If
			If chk_recurse.checked = True Then
				GetOUObjects objObject.adsPath
			End If
		Next
	End Sub
	
	Sub Export_Excel
		Set objExcel = CreateObject("Excel.Application")
		Set objWB = objExcel.Workbooks.Add
		Set objSheet = objWB.Sheets(1)
		objExcel.Visible = True
		objSheet.Cells(1, 1).Value = "Report Date " & Date
		objSheet.Cells(1, 1).Font.Bold = True
		objSheet.Cells(2, 2).Value = "Users"
		objSheet.Cells(2, 3).Value = "Computers"
		objSheet.Cells(2, 4).Value = "Groups"
		objSheet.Cells(2, 5).Value = "Mail-Enabled Users"
		objSheet.Cells(2, 6).Value = "Mail-Enabled Groups"
		objSheet.Cells(2, 7).Value = "Disabled Users"
		objSheet.Cells(2, 8).Value = "Disabled Computers"
		objSheet.Rows("2:2").Font.Bold = True
		objSheet.Cells(3, 1).Value = "OU with Sub OU's if they exist"
		objSheet.Cells(3, 1).Font.ColorIndex = 55
		objSheet.Cells(3, 1).Font.Bold = True
 
		Const adVarChar = 200
		Const adBigInt = 20
		Const MaxCharacters = 255	
		Set DataList = CreateObject("ADOR.Recordset")
		DataList.Fields.Append "OU", adVarChar, MaxCharacters
		DataList.Fields.Append "Users", adBigInt
		DataList.Fields.Append "Computers", adBigInt
		DataList.Fields.Append "Groups", adBigInt
		DataList.Fields.Append "MailEnabledUsers", adBigInt
		DataList.Fields.Append "MailEnabledGroups", adBigInt
		DataList.Fields.Append "DisabledUsers", adBigInt
		DataList.Fields.Append "DisabledComputers", adBigInt
		
		DataList.Open
		
		' Users
		For Each objEntry In lst_Users.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Users") = 1
				DataList.Update
			Else
				DataList("Users") = CInt(DataList("Users")) + 1
			End If
		Next
		
		' Computers
		For Each objEntry In lst_Computers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Computers") = 1
				DataList.Update
			Else
				DataList("Computers") = CInt(DataList("Computers")) + 1
			End If
		Next
 
		' Groups
		For Each objEntry In lst_groups.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Groups") = 1
				DataList.Update
			Else
				DataList("Groups") = CInt(DataList("Groups")) + 1
			End If
		Next
 
		' Mail-Enalbed Users
		For Each objEntry In lst_mailenabledusers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("MailEnabledUsers") = 1
				DataList.Update
			Else
				DataList("MailEnabledUsers") = CInt(DataList("MailEnabledUsers")) + 1
			End If
		Next
 
		' Mail-Enalbed Groups
		For Each objEntry In lst_mailenabledgroups.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("MailEnabledGroups") = 1
				DataList.Update
			Else
				DataList("MailEnabledGroups") = CInt(DataList("MailEnabledGroups")) + 1
			End If
		Next
 
		' Disabled Users
		For Each objEntry In lst_disabledusers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("DisabledUsers") = 1
				DataList.Update
			Else
				DataList("DisabledUsers") = CInt(DataList("DisabledUsers")) + 1
			End If
		Next
 
		' Disabled Computers
		For Each objEntry In lst_disabledcomputers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("DisabledComputers") = 1
				DataList.Update
			Else
				DataList("DisabledComputers") = CInt(DataList("DisabledComputers")) + 1
			End If
		Next
 
		' Output
		DataList.filter = ""
		DataList.Sort = "OU"
		If Not DataList.BOF Then DataList.MoveFirst
		intRow = 4
		While Not DataList.EOF
			For intCol = 2 To 8
				objSheet.Cells(intRow, intCol).Value = 0
			Next
			objSheet.Cells(intRow, 1).Value = DataList("OU")
			If DataList("Users") = "" Then
				objSheet.Cells(intRow, 2).Value = 0
			Else
				objSheet.Cells(intRow, 2).Value = DataList("Users")
			End If
			If DataList("Computers") = "" Then
				objSheet.Cells(intRow, 3).Value = 0
			Else
				objSheet.Cells(intRow, 3).Value = DataList("Computers")
			End If
			If DataList("Groups") = "" Then
				objSheet.Cells(intRow, 4).Value = 0
			Else
				objSheet.Cells(intRow, 4).Value = DataList("Groups")
			End If
			If DataList("MailEnabledUsers") = "" Then
				objSheet.Cells(intRow, 5).Value = 0
			Else
				objSheet.Cells(intRow, 5).Value = DataList("MailEnabledUsers")
			End If
			If DataList("MailEnabledGroups") = "" Then
				objSheet.Cells(intRow, 6).Value = 0
			Else
				objSheet.Cells(intRow, 6).Value = DataList("MailEnabledGroups")
			End If
			If DataList("DisabledUsers") = "" Then
				objSheet.Cells(intRow, 7).Value = 0
			Else
				objSheet.Cells(intRow, 7).Value = DataList("DisabledUsers")
			End If
			If DataList("DisabledComputers") = "" Then
				objSheet.Cells(intRow, 8).Value = 0
			Else
				objSheet.Cells(intRow, 8).Value = DataList("DisabledComputers")
			End If
			intRow = intRow + 1
			DataList.MoveNext
		Wend
		objSheet.Columns.AutoFit
		intRow = intRow + 1
		objSheet.Cells(intRow, 1).Value = "TOTAL:"
		objSheet.Rows(intRow & ":" & intRow).Font.Bold = True
		objSheet.Rows(intRow & ":" & intRow).Font.ColorIndex = 55
		For intCol = 2 To 8
			strFormula = "=SUM(" & Chr((intCol) + 64) & "4:" & Chr((intCol) + 64) & intRow - 2 & ")"
			objSheet.Cells(intRow, intCol).Formula = strFormula
		Next
	End Sub
</script>
<body style="background-color:#B0C4DE;" onkeypress='vbs:Default_Buttons'>
	<table height="90%" width= "90%" border="0" align="center">
		<tr>
			<td align="center" colspan="3">
				<h2>List OU Users, Computers, and Groups</h2>
			</td>
		</tr>
		<tr>
			<td>
				<b>Site Filter:</b><br>Select multiple OUs with<br>CTRL + Click
			</td>
			<td colspan="2">
			    <select size='8' name='lst_SiteFilter'  onChange='vbs:Show_Selection' multiple="True">
				</select>
			</td>
		</tr>
		<tr>
			<td>
				&nbsp;
			</td>
			<td>
				<input type="checkbox" id="chk_recurse" name="chk_recurse">Recurse Sub OUs
			</td>
			<td>
				<button name="btn_run" id="btn_run" accessKey="G" onclick="vbs:Get_Members"><u>G</u>et Members</button>
			</td>
		</tr>
		<tr>
			<td colspan=3>
				<b>OU Selected:</b>&nbsp&nbsp&nbsp<span id='span_SiteFilter'></span>
			</td>
		</tr>
		<tr>
			<td>
				<b>Users:</b><br>
			    <select size='4' name='lst_users'>
				</select>
				<br><b>Total: </b><span id="span_totalusers"></span>
			</td>
			<td>
				<b>Computers:</b><br>
			    <select size='4' name='lst_computers'>
				</select>
				<br><b>Total: </b><span id="span_totalcomputers"></span>
			</td>
			<td>
				<b>Groups:</b><br>
			    <select size='4' name='lst_groups'>
				</select>
				<br><b>Total: </b><span id="span_totalgroups"></span>
			</td>
		</tr>
		<tr>
			<td>
				<b>Mail-Enabled Users:</b><br>
			    <select size='4' name='lst_mailenabledusers'>
				</select>
				<br><b>Total: </b><span id="span_totalmailusers"></span>
			</td>
			<td>
				&nbsp;
			</td>
			<td>
				<b>Mail-Enabled Groups:</b><br>
			    <select size='4' name='lst_mailenabledgroups'>
				</select>
				<br><b>Total: </b><span id="span_totalmailgroups"></span>
			</td>
		</tr>
		<tr>
			<td>
				<b>Disabled Users:</b><br>
			    <select size='4' name='lst_disabledusers'>
				</select>
				<br><b>Total: </b><span id="span_totaldisabledusers"></span>
			</td>
			<td>
				<b>Disabled Computers:</b><br>
			    <select size='4' name='lst_disabledcomputers'>
				</select>
				<br><b>Total: </b><span id="span_totaldisabledcomputers"></span>
			</td>
			<td>
				&nbsp;
			</td>
		</tr>
	</table>
	<table width= "90%" border="0" align="center">
		<tr align="center">
			<td>
				<button name="btn_exportexcel" id="btn_exportexcel" accessKey="e" onclick="vbs:Export_Excel"><u>E</u>xport to Excel</button>
			</td>
		</tr>
		<tr align="center">
			<td>
				<button name="btn_exit" id="btn_exit" accessKey="x" onclick="vbs:Exit_HTA">E<u>x</u>it</button>
			</td>
		</tr>
	</table>
</body>
</head>
</html>

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:

Select all Open in new window

by: eperez0968Posted on 2009-11-09 at 06:52:15ID: 25776368

Hi Rob,
I must say I am very impressed :). This is so awesome!!!!!! I would have to give you many props for this; it is exactly what I needed.
1. To answer the issue about the mail enabled accounts, if you could, lets add it to the fields, I would not pull them out from the users or groups field lets keep them there, I dont mind it being a duplicate in the Mail-Enabled Users and Mail-Enabled Groups field because I can do a check and balance on why I have users or groups that are disabled that have e-mails.
2. Last request, I promise :) would it be too time consuming to have it separated as per the selection I choose, example would be from my excel sheet I have provided as an example. If its going to take you to long then dont worry about it, this does what I need.

I hope I explained myself correctly, let me know if I need to explain my requests a bit better.

Thanks again.
Eric

by: RobSampsonPosted on 2009-11-09 at 13:07:51ID: 25780088

Hi, no problem. It's a pretty neat report that I wasn't entirely sure I could do myself, so I'm pleased with it.

1. I can do this, but your "Total" in the Excel report would contain a two for one count, and would be inaccurate, but we'll see how you go with that.

2. I think I can do that. The current output is sorted by OU, so I should be able to check those against the actual selected item(s) in the list box and total them up that way.

Regards,

Rob.

by: RobSampsonPosted on 2009-11-09 at 19:08:18ID: 25782063

OK, give this version a whirl.

Regards,

Rob.

<Html>
<Head>
<Title>List OU Users, Computers, and Groups</Title>
 
<HTA:Application
Caption = Yes
Border = Thick
ShowInTaskBar = Yes
SingleInstance = Yes
MaximizeButton = Yes
MinimizeButton = Yes>
 
<script Language = VBScript>
 
	Sub Window_OnLoad
		intWidth = 800
		intHeight = 800
		Me.ResizeTo intWidth, intHeight
		Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
		lst_users.Style.Width = 200
		lst_computers.Style.Width = 200
		lst_groups.Style.Width = 200
		lst_mailenabledusers.Style.Width = 200
		lst_mailenabledgroups.Style.Width = 200
		lst_disabledusers.Style.Width = 200
		lst_disabledcomputers.Style.Width = 200
    	Set objRootDSE = GetObject("LDAP://RootDSE")
    	strBaseConnString = objRootDSE.Get("defaultNamingContext")
		Set objOULevel = GetObject("LDAP://" & strBaseConnString)
		RecurseOUs objOULevel, 0, strBaseConnString
		Show_Selection
	End Sub
 
	Sub Clear_Users
		For intListProgress = 1 To lst_Users.Length
	   		lst_Users.Remove 0
	   	Next
	   	span_totalusers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_Computers
		For intListProgress = 1 To lst_computers.Length
	   		lst_computers.Remove 0
	   	Next
	   	span_totalcomputers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_Groups
		For intListProgress = 1 To lst_groups.Length
	   		lst_groups.Remove 0
	   	Next
	   	span_totalgroups.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_MailEnabledUsers
		For intListProgress = 1 To lst_mailenabledusers.Length
	   		lst_mailenabledusers.Remove 0
	   	Next
	   	span_totalmailusers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_MailEnabledGroups
		For intListProgress = 1 To lst_mailenabledgroups.Length
	   		lst_mailenabledgroups.Remove 0
	   	Next
	   	span_totalmailgroups.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_DisabledUsers
		For intListProgress = 1 To lst_disabledusers.Length
	   		lst_disabledusers.Remove 0
	   	Next
	   	span_totaldisabledusers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_DisabledComputers
		For intListProgress = 1 To lst_disabledcomputers.Length
	   		lst_disabledcomputers.Remove 0
	   	Next
	   	span_totaldisabledcomputers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub RecurseOUs(objOU, intLevel, strBaseConn)
		Dim objOUObject, strConnString, objActiveOption
		For Each objOUObject In objOU
			If UCase(Left(objOUObject.Name, 3)) = "OU=" Then
				strConnString = objOUObject.DistinguishedName
				Set objActiveOption = Document.CreateElement("OPTION")
		    	If intLevel = 0 Then
		    		objActiveOption.Text = Replace(objOUObject.Name, "OU=", "")
		    	Else
		    		objActiveOption.Text = String(intLevel * 4, " ") & "->   " & Replace(objOUObject.Name, "OU=", "")
		    	End If
		    	objActiveOption.Value = strConnString
		    	lst_SiteFilter.Add objActiveOption
				On Error Resume Next
				RecurseOUs GetObject("LDAP://" & strConnString), intLevel + 1, strBaseConn
				If Err.Number <> 0 Then
					MsgBox "Error enumerating " & strConnString
				End If
				Err.Clear
				On Error GoTo 0
			End If
		Next
	End Sub
 
	Sub Show_Selection
		span_SiteFilter.InnerHTML = ""
		For Each objOption In lst_SiteFilter.Options
			If objOption.Selected = True Then
				If span_SiteFilter.InnerHTML = "" Then
					span_SiteFilter.InnerHTML = objOption.Value
				Else
					span_SiteFilter.InnerHTML = span_SiteFilter.InnerHTML & "<BR>" & objOption.Value
				End If
			End If
		Next
	End Sub
 
	Sub Default_Buttons
		If Window.Event.KeyCode = 13 Then
			btn_run.Click
		End If
	End Sub
 
	Sub Exit_HTA
		Window.Close
	End Sub
 
	Sub Get_Members
		Clear_Users
		Clear_Computers
		Clear_Groups
		Clear_MailEnabledUsers
		Clear_MailEnabledGroups
		Clear_DisabledUsers
		Clear_DisabledComputers
		
		Set objConnection2 = CreateObject("ADODB.Connection")
		Set objCommand2 = CreateObject("ADODB.Command")
		objConnection2.Provider = "ADsDSOObject"
		objConnection2.Open "Active Directory Provider"
		Set objCommand2.ActiveConnection = objConnection2
		
		For Each strOU In Split(span_sitefilter.InnerHTML, "<BR>")
			GetOUObjects("LDAP://" & strOU)
		Next
		
		span_totalusers.InnerHTML = "<b>" & lst_users.Length & "</b>"
		span_totalcomputers.InnerHTML = "<b>" & lst_computers.Length & "</b>"
		span_totalgroups.InnerHTML = "<b>" & lst_groups.Length & "</b>"
		span_totalmailusers.InnerHTML = "<b>" & lst_mailenabledusers.Length & "</b>"
		span_totalmailgroups.InnerHTML = "<b>" & lst_mailenabledgroups.Length & "</b>"
		span_totaldisabledusers.InnerHTML = "<b>" & lst_disabledusers.Length & "</b>"
		span_totaldisabledcomputers.InnerHTML = "<b>" & lst_disabledcomputers.Length & "</b>"
	End Sub
	
	Sub GetOUObjects(strLDAPPath)
		Const ADS_UF_ACCOUNTDISABLE = 2
		Set objOU = GetObject(strLDAPPath)
		For Each objObject In objOU
			Set objMember = Document.CreateElement("OPTION")
			objMember.Text = objObject.cn
	        objMember.Value = objObject.distinguishedname
			If LCase(objObject.Class) = "user" Then
				intUAC = objObject.userAccountControl
				If intUAC And ADS_UF_ACCOUNTDISABLE Then
					lst_disabledusers.Add objMember, 0
				Else
					lst_users.Add objMember, 0
				End If
				On Error Resume Next
				If objObject.mail <> "" Or IsNull(objObject.mail) = True Then
					lst_mailenabledusers.Add objMember, 0
				End If
				Err.Clear
				On Error GoTo 0
			ElseIf LCase(objObject.Class) = "computer" Then
				intUAC = objObject.userAccountControl
				If intUAC And ADS_UF_ACCOUNTDISABLE Then
					lst_disabledcomputers.Add objMember, 0
				Else
					lst_computers.Add objMember, 0
				End If
			ElseIf LCase(objObject.Class) = "group" Then
				lst_groups.Add objMember, 0
				On Error Resume Next
				If objObject.mail <> "" Or IsNull(objObject.mail) = True Then
					lst_mailenabledusers.Add objMember, 0
				End If
				Err.Clear
				On Error GoTo 0
			End If
			If chk_recurse.checked = True Then
				GetOUObjects objObject.adsPath
			End If
		Next
	End Sub
	
	Sub Export_Excel
		Set objExcel = CreateObject("Excel.Application")
		Set objWB = objExcel.Workbooks.Add
		Set objSheet = objWB.Sheets(1)
		objExcel.Visible = True
		objSheet.Cells(1, 1).Value = "Report Date " & Date
		objSheet.Cells(1, 1).Font.Bold = True
		objSheet.Cells(2, 2).Value = "Users"
		objSheet.Cells(2, 3).Value = "Computers"
		objSheet.Cells(2, 4).Value = "Groups"
		objSheet.Cells(2, 5).Value = "Mail-Enabled Users"
		objSheet.Cells(2, 6).Value = "Mail-Enabled Groups"
		objSheet.Cells(2, 7).Value = "Disabled Users"
		objSheet.Cells(2, 8).Value = "Disabled Computers"
		objSheet.Rows("2:2").Font.Bold = True
 
		Const adVarChar = 200
		Const adBigInt = 20
		Const MaxCharacters = 255	
		Set DataList = CreateObject("ADOR.Recordset")
		DataList.Fields.Append "OU", adVarChar, MaxCharacters
		DataList.Fields.Append "Users", adBigInt
		DataList.Fields.Append "Computers", adBigInt
		DataList.Fields.Append "Groups", adBigInt
		DataList.Fields.Append "MailEnabledUsers", adBigInt
		DataList.Fields.Append "MailEnabledGroups", adBigInt
		DataList.Fields.Append "DisabledUsers", adBigInt
		DataList.Fields.Append "DisabledComputers", adBigInt
		
		DataList.Open
		
		' Users
		For Each objEntry In lst_Users.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Users") = 1
				DataList.Update
			Else
				DataList("Users") = CInt(DataList("Users")) + 1
			End If
		Next
		
		' Computers
		For Each objEntry In lst_Computers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Computers") = 1
				DataList.Update
			Else
				DataList("Computers") = CInt(DataList("Computers")) + 1
			End If
		Next
 
		' Groups
		For Each objEntry In lst_groups.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Groups") = 1
				DataList.Update
			Else
				DataList("Groups") = CInt(DataList("Groups")) + 1
			End If
		Next
 
		' Mail-Enalbed Users
		For Each objEntry In lst_mailenabledusers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("MailEnabledUsers") = 1
				DataList.Update
			Else
				DataList("MailEnabledUsers") = CInt(DataList("MailEnabledUsers")) + 1
			End If
		Next
 
		' Mail-Enalbed Groups
		For Each objEntry In lst_mailenabledgroups.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("MailEnabledGroups") = 1
				DataList.Update
			Else
				DataList("MailEnabledGroups") = CInt(DataList("MailEnabledGroups")) + 1
			End If
		Next
 
		' Disabled Users
		For Each objEntry In lst_disabledusers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("DisabledUsers") = 1
				DataList.Update
			Else
				DataList("DisabledUsers") = CInt(DataList("DisabledUsers")) + 1
			End If
		Next
 
		' Disabled Computers
		For Each objEntry In lst_disabledcomputers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("DisabledComputers") = 1
				DataList.Update
			Else
				DataList("DisabledComputers") = CInt(DataList("DisabledComputers")) + 1
			End If
		Next
 
		' Output
		DataList.filter = ""
		DataList.Sort = "OU"
		If Not DataList.BOF Then DataList.MoveFirst
		' Create a dictionary object of the selected OUs to segment the report with
		Set objOUs = CreateObject("Scripting.Dictionary")
		For Each strSelectedOU In Split(span_sitefilter.InnerHTML, "<BR>")
			arrOU = Split(strSelectedOU, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			objOUs.Add LCase(strOU), 0
		Next
		intRow = 2
		For Each strSelectedOU In objOUs
			intRow = intRow + 2
			objSheet.Cells(intRow, 1).Value = "OU with Sub OU's if they exist"
			objSheet.Cells(intRow, 1).Font.ColorIndex = 55
			objSheet.Cells(intRow, 1).Font.Bold = True
			intRow = intRow + 1
			intStartRow = intRow
			DataList.MoveFirst
			While Not DataList.EOF
				If InStr(LCase(DataList("OU")), LCase(strSelectedOU)) > 0 Then
					For intCol = 2 To 8
						objSheet.Cells(intRow, intCol).Value = 0
					Next
					objSheet.Cells(intRow, 1).Value = DataList("OU")
					If DataList("Users") = "" Then
						objSheet.Cells(intRow, 2).Value = 0
					Else
						objSheet.Cells(intRow, 2).Value = DataList("Users")
					End If
					If DataList("Computers") = "" Then
						objSheet.Cells(intRow, 3).Value = 0
					Else
						objSheet.Cells(intRow, 3).Value = DataList("Computers")
					End If
					If DataList("Groups") = "" Then
						objSheet.Cells(intRow, 4).Value = 0
					Else
						objSheet.Cells(intRow, 4).Value = DataList("Groups")
					End If
					If DataList("MailEnabledUsers") = "" Then
						objSheet.Cells(intRow, 5).Value = 0
					Else
						objSheet.Cells(intRow, 5).Value = DataList("MailEnabledUsers")
					End If
					If DataList("MailEnabledGroups") = "" Then
						objSheet.Cells(intRow, 6).Value = 0
					Else
						objSheet.Cells(intRow, 6).Value = DataList("MailEnabledGroups")
					End If
					If DataList("DisabledUsers") = "" Then
						objSheet.Cells(intRow, 7).Value = 0
					Else
						objSheet.Cells(intRow, 7).Value = DataList("DisabledUsers")
					End If
					If DataList("DisabledComputers") = "" Then
						objSheet.Cells(intRow, 8).Value = 0
					Else
						objSheet.Cells(intRow, 8).Value = DataList("DisabledComputers")
					End If
					intRow = intRow + 1
				End If
				DataList.MoveNext
			Wend
			intRow = intRow + 1
			objSheet.Cells(intRow, 1).Value = "TOTAL:"
			objSheet.Rows(intRow & ":" & intRow).Font.Bold = True
			objSheet.Rows(intRow & ":" & intRow).Font.ColorIndex = 55
			For intCol = 2 To 8
				strFormula = "=SUM(" & Chr((intCol) + 64) & intStartRow & ":" & Chr((intCol) + 64) & intRow - 2 & ")"
				objSheet.Cells(intRow, intCol).Formula = strFormula
			Next
		Next
		objSheet.Columns.AutoFit
	End Sub
</script>
<body style="background-color:#B0C4DE;" onkeypress='vbs:Default_Buttons'>
	<table height="90%" width= "90%" border="0" align="center">
		<tr>
			<td align="center" colspan="3">
				<h2>List OU Users, Computers, and Groups</h2>
			</td>
		</tr>
		<tr>
			<td>
				<b>Site Filter:</b><br>Select multiple OUs with<br>CTRL + Click
			</td>
			<td colspan="2">
			    <select size='8' name='lst_SiteFilter'  onChange='vbs:Show_Selection' multiple="True">
				</select>
			</td>
		</tr>
		<tr>
			<td>
				&nbsp;
			</td>
			<td>
				<input type="checkbox" id="chk_recurse" name="chk_recurse">Recurse Sub OUs
			</td>
			<td>
				<button name="btn_run" id="btn_run" accessKey="G" onclick="vbs:Get_Members"><u>G</u>et Members</button>
			</td>
		</tr>
		<tr>
			<td colspan=3>
				<b>OU Selected:</b>&nbsp&nbsp&nbsp<span id='span_SiteFilter'></span>
			</td>
		</tr>
		<tr>
			<td>
				<b>Users:</b><br>
			    <select size='4' name='lst_users'>
				</select>
				<br><b>Total: </b><span id="span_totalusers"></span>
			</td>
			<td>
				<b>Computers:</b><br>
			    <select size='4' name='lst_computers'>
				</select>
				<br><b>Total: </b><span id="span_totalcomputers"></span>
			</td>
			<td>
				<b>Groups:</b><br>
			    <select size='4' name='lst_groups'>
				</select>
				<br><b>Total: </b><span id="span_totalgroups"></span>
			</td>
		</tr>
		<tr>
			<td>
				<b>Mail-Enabled Users:</b><br>
			    <select size='4' name='lst_mailenabledusers'>
				</select>
				<br><b>Total: </b><span id="span_totalmailusers"></span>
			</td>
			<td>
				&nbsp;
			</td>
			<td>
				<b>Mail-Enabled Groups:</b><br>
			    <select size='4' name='lst_mailenabledgroups'>
				</select>
				<br><b>Total: </b><span id="span_totalmailgroups"></span>
			</td>
		</tr>
		<tr>
			<td>
				<b>Disabled Users:</b><br>
			    <select size='4' name='lst_disabledusers'>
				</select>
				<br><b>Total: </b><span id="span_totaldisabledusers"></span>
			</td>
			<td>
				<b>Disabled Computers:</b><br>
			    <select size='4' name='lst_disabledcomputers'>
				</select>
				<br><b>Total: </b><span id="span_totaldisabledcomputers"></span>
			</td>
			<td>
				&nbsp;
			</td>
		</tr>
	</table>
	<table width= "90%" border="0" align="center">
		<tr align="center">
			<td>
				<button name="btn_exportexcel" id="btn_exportexcel" accessKey="e" onclick="vbs:Export_Excel"><u>E</u>xport to Excel</button>
			</td>
		</tr>
		<tr align="center">
			<td>
				<button name="btn_exit" id="btn_exit" accessKey="x" onclick="vbs:Exit_HTA">E<u>x</u>it</button>
			</td>
		</tr>
	</table>
</body>
</head>
</html>

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:
557:
558:
559:
560:
561:
562:
563:
564:
565:
566:
567:
568:
569:
570:
571:
572:
573:
574:
575:
576:
577:
578:
579:
580:
581:
582:
583:
584:
585:
586:

Select all Open in new window

by: eperez0968Posted on 2009-11-10 at 04:45:55ID: 25784753

Hi Rob,
Everything is perfect, you have to love the work you did, this is awsome. format is perfect, you out did yourself again :)

the only thing it is not showing the Mail-Enabled Users and Mail-Enabled Groups in the boxes and when i hit the Export to excel it does not have the totals either.

Thanks,
Eric

by: RobSampsonPosted on 2009-11-10 at 15:56:20ID: 25791288

OK, I think I fixed the mail-enabled issue. I had the logic wrong.

I have also added an HTML export, if you want to use that. It automatically saves to
HTML_Report_YYYYMMDDHHMMSS.html

in the current directory.

Regards,

Rob.

<Html>
<Head>
<Title>List OU Users, Computers, and Groups</Title>
 
<HTA:Application
Caption = Yes
Border = Thick
ShowInTaskBar = Yes
SingleInstance = Yes
MaximizeButton = Yes
MinimizeButton = Yes>
 
<script Language = VBScript>
 
	Sub Window_OnLoad
		intWidth = 800
		intHeight = 800
		Me.ResizeTo intWidth, intHeight
		Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
		lst_users.Style.Width = 200
		lst_computers.Style.Width = 200
		lst_groups.Style.Width = 200
		lst_mailenabledusers.Style.Width = 200
		lst_mailenabledgroups.Style.Width = 200
		lst_disabledusers.Style.Width = 200
		lst_disabledcomputers.Style.Width = 200
    	Set objRootDSE = GetObject("LDAP://RootDSE")
    	strBaseConnString = objRootDSE.Get("defaultNamingContext")
		Set objOULevel = GetObject("LDAP://" & strBaseConnString)
		RecurseOUs objOULevel, 0, strBaseConnString
		Show_Selection
	End Sub
 
	Sub Clear_Users
		For intListProgress = 1 To lst_Users.Length
	   		lst_Users.Remove 0
	   	Next
	   	span_totalusers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_Computers
		For intListProgress = 1 To lst_computers.Length
	   		lst_computers.Remove 0
	   	Next
	   	span_totalcomputers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_Groups
		For intListProgress = 1 To lst_groups.Length
	   		lst_groups.Remove 0
	   	Next
	   	span_totalgroups.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_MailEnabledUsers
		For intListProgress = 1 To lst_mailenabledusers.Length
	   		lst_mailenabledusers.Remove 0
	   	Next
	   	span_totalmailusers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_MailEnabledGroups
		For intListProgress = 1 To lst_mailenabledgroups.Length
	   		lst_mailenabledgroups.Remove 0
	   	Next
	   	span_totalmailgroups.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_DisabledUsers
		For intListProgress = 1 To lst_disabledusers.Length
	   		lst_disabledusers.Remove 0
	   	Next
	   	span_totaldisabledusers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_DisabledComputers
		For intListProgress = 1 To lst_disabledcomputers.Length
	   		lst_disabledcomputers.Remove 0
	   	Next
	   	span_totaldisabledcomputers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub RecurseOUs(objOU, intLevel, strBaseConn)
		Dim objOUObject, strConnString, objActiveOption
		For Each objOUObject In objOU
			If UCase(Left(objOUObject.Name, 3)) = "OU=" Then
				strConnString = objOUObject.DistinguishedName
				Set objActiveOption = Document.CreateElement("OPTION")
		    	If intLevel = 0 Then
		    		objActiveOption.Text = Replace(objOUObject.Name, "OU=", "")
		    	Else
		    		objActiveOption.Text = String(intLevel * 4, " ") & "->   " & Replace(objOUObject.Name, "OU=", "")
		    	End If
		    	objActiveOption.Value = strConnString
		    	lst_SiteFilter.Add objActiveOption
				On Error Resume Next
				RecurseOUs GetObject("LDAP://" & strConnString), intLevel + 1, strBaseConn
				If Err.Number <> 0 Then
					MsgBox "Error enumerating " & strConnString
				End If
				Err.Clear
				On Error GoTo 0
			End If
		Next
	End Sub
 
	Sub Show_Selection
		span_SiteFilter.InnerHTML = ""
		For Each objOption In lst_SiteFilter.Options
			If objOption.Selected = True Then
				If span_SiteFilter.InnerHTML = "" Then
					span_SiteFilter.InnerHTML = objOption.Value
				Else
					span_SiteFilter.InnerHTML = span_SiteFilter.InnerHTML & "<BR>" & objOption.Value
				End If
			End If
		Next
	End Sub
 
	Sub Default_Buttons
		If Window.Event.KeyCode = 13 Then
			btn_run.Click
		End If
	End Sub
 
	Sub Exit_HTA
		Window.Close
	End Sub
 
	Sub Get_Members
		Clear_Users
		Clear_Computers
		Clear_Groups
		Clear_MailEnabledUsers
		Clear_MailEnabledGroups
		Clear_DisabledUsers
		Clear_DisabledComputers
		
		Set objConnection2 = CreateObject("ADODB.Connection")
		Set objCommand2 = CreateObject("ADODB.Command")
		objConnection2.Provider = "ADsDSOObject"
		objConnection2.Open "Active Directory Provider"
		Set objCommand2.ActiveConnection = objConnection2
		
		For Each strOU In Split(span_sitefilter.InnerHTML, "<BR>")
			GetOUObjects("LDAP://" & strOU)
		Next
		
		span_totalusers.InnerHTML = "<b>" & lst_users.Length & "</b>"
		span_totalcomputers.InnerHTML = "<b>" & lst_computers.Length & "</b>"
		span_totalgroups.InnerHTML = "<b>" & lst_groups.Length & "</b>"
		span_totalmailusers.InnerHTML = "<b>" & lst_mailenabledusers.Length & "</b>"
		span_totalmailgroups.InnerHTML = "<b>" & lst_mailenabledgroups.Length & "</b>"
		span_totaldisabledusers.InnerHTML = "<b>" & lst_disabledusers.Length & "</b>"
		span_totaldisabledcomputers.InnerHTML = "<b>" & lst_disabledcomputers.Length & "</b>"
	End Sub
	
	Sub GetOUObjects(strLDAPPath)
		Const ADS_UF_ACCOUNTDISABLE = 2
		Set objOU = GetObject(strLDAPPath)
		For Each objObject In objOU
			Set objMember = Document.CreateElement("OPTION")
			objMember.Text = objObject.cn
	        objMember.Value = objObject.distinguishedname
			If LCase(objObject.Class) = "user" Then
				intUAC = objObject.userAccountControl
				If intUAC And ADS_UF_ACCOUNTDISABLE Then
					lst_disabledusers.Add objMember, 0
				Else
					lst_users.Add objMember, 0
				End If
				strMail = ""
				On Error Resume Next
				strMail = objObject.mail
				Err.Clear
				On Error GoTo 0
				If strMail <> "" And IsNull(objObject.mail) = False Then
					lst_mailenabledusers.Add objMember, 0
				End If
				Err.Clear
				On Error GoTo 0
			ElseIf LCase(objObject.Class) = "computer" Then
				intUAC = objObject.userAccountControl
				If intUAC And ADS_UF_ACCOUNTDISABLE Then
					lst_disabledcomputers.Add objMember, 0
				Else
					lst_computers.Add objMember, 0
				End If
			ElseIf LCase(objObject.Class) = "group" Then
				lst_groups.Add objMember, 0
				strMail = ""
				On Error Resume Next
				strMail = objObject.mail
				Err.Clear
				On Error GoTo 0
				If strMail <> "" And IsNull(objObject.mail) = False Then
					lst_mailenabledgroups.Add objMember, 0
				End If
				Err.Clear
				On Error GoTo 0
			End If
			If chk_recurse.checked = True Then
				GetOUObjects objObject.adsPath
			End If
		Next
	End Sub
	
	Sub Export_Excel
		Set objExcel = CreateObject("Excel.Application")
		Set objWB = objExcel.Workbooks.Add
		Set objSheet = objWB.Sheets(1)
		objExcel.Visible = True
		objSheet.Cells(1, 1).Value = "Report Date " & Date
		objSheet.Cells(1, 1).Font.Bold = True
		objSheet.Cells(2, 2).Value = "Users"
		objSheet.Cells(2, 3).Value = "Computers"
		objSheet.Cells(2, 4).Value = "Groups"
		objSheet.Cells(2, 5).Value = "Mail-Enabled Users"
		objSheet.Cells(2, 6).Value = "Mail-Enabled Groups"
		objSheet.Cells(2, 7).Value = "Disabled Users"
		objSheet.Cells(2, 8).Value = "Disabled Computers"
		objSheet.Rows("2:2").Font.Bold = True
 
		Const adVarChar = 200
		Const adBigInt = 20
		Const MaxCharacters = 255	
		Set DataList = CreateObject("ADOR.Recordset")
		DataList.Fields.Append "OU", adVarChar, MaxCharacters
		DataList.Fields.Append "Users", adBigInt
		DataList.Fields.Append "Computers", adBigInt
		DataList.Fields.Append "Groups", adBigInt
		DataList.Fields.Append "MailEnabledUsers", adBigInt
		DataList.Fields.Append "MailEnabledGroups", adBigInt
		DataList.Fields.Append "DisabledUsers", adBigInt
		DataList.Fields.Append "DisabledComputers", adBigInt
		
		DataList.Open
		
		' Users
		For Each objEntry In lst_Users.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Users") = 1
				DataList.Update
			Else
				DataList("Users") = CInt(DataList("Users")) + 1
			End If
		Next
		
		' Computers
		For Each objEntry In lst_Computers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Computers") = 1
				DataList.Update
			Else
				DataList("Computers") = CInt(DataList("Computers")) + 1
			End If
		Next
 
		' Groups
		For Each objEntry In lst_groups.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Groups") = 1
				DataList.Update
			Else
				DataList("Groups") = CInt(DataList("Groups")) + 1
			End If
		Next
 
		' Mail-Enalbed Users
		For Each objEntry In lst_mailenabledusers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("MailEnabledUsers") = 1
				DataList.Update
			Else
				DataList("MailEnabledUsers") = CInt(DataList("MailEnabledUsers")) + 1
			End If
		Next
 
		' Mail-Enalbed Groups
		For Each objEntry In lst_mailenabledgroups.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("MailEnabledGroups") = 1
				DataList.Update
			Else
				DataList("MailEnabledGroups") = CInt(DataList("MailEnabledGroups")) + 1
			End If
		Next
 
		' Disabled Users
		For Each objEntry In lst_disabledusers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("DisabledUsers") = 1
				DataList.Update
			Else
				DataList("DisabledUsers") = CInt(DataList("DisabledUsers")) + 1
			End If
		Next
 
		' Disabled Computers
		For Each objEntry In lst_disabledcomputers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("DisabledComputers") = 1
				DataList.Update
			Else
				DataList("DisabledComputers") = CInt(DataList("DisabledComputers")) + 1
			End If
		Next
 
		' Output
		DataList.filter = ""
		DataList.Sort = "OU"
		If Not DataList.BOF Then DataList.MoveFirst
		' Create a dictionary object of the selected OUs to segment the report with
		Set objOUs = CreateObject("Scripting.Dictionary")
		For Each strSelectedOU In Split(span_sitefilter.InnerHTML, "<BR>")
			arrOU = Split(strSelectedOU, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			objOUs.Add LCase(strOU), 0
		Next
		intRow = 2
		For Each strSelectedOU In objOUs
			intRow = intRow + 2
			objSheet.Cells(intRow, 1).Value = "OU with Sub OU's if they exist"
			objSheet.Cells(intRow, 1).Font.ColorIndex = 55
			objSheet.Cells(intRow, 1).Font.Bold = True
			intRow = intRow + 1
			intStartRow = intRow
			DataList.MoveFirst
			While Not DataList.EOF
				If InStr(LCase(DataList("OU")), LCase(strSelectedOU)) > 0 Then
					For intCol = 2 To 8
						objSheet.Cells(intRow, intCol).Value = 0
					Next
					objSheet.Cells(intRow, 1).Value = DataList("OU")
					If DataList("Users") = "" Then
						objSheet.Cells(intRow, 2).Value = 0
					Else
						objSheet.Cells(intRow, 2).Value = DataList("Users")
					End If
					If DataList("Computers") = "" Then
						objSheet.Cells(intRow, 3).Value = 0
					Else
						objSheet.Cells(intRow, 3).Value = DataList("Computers")
					End If
					If DataList("Groups") = "" Then
						objSheet.Cells(intRow, 4).Value = 0
					Else
						objSheet.Cells(intRow, 4).Value = DataList("Groups")
					End If
					If DataList("MailEnabledUsers") = "" Then
						objSheet.Cells(intRow, 5).Value = 0
					Else
						objSheet.Cells(intRow, 5).Value = DataList("MailEnabledUsers")
					End If
					If DataList("MailEnabledGroups") = "" Then
						objSheet.Cells(intRow, 6).Value = 0
					Else
						objSheet.Cells(intRow, 6).Value = DataList("MailEnabledGroups")
					End If
					If DataList("DisabledUsers") = "" Then
						objSheet.Cells(intRow, 7).Value = 0
					Else
						objSheet.Cells(intRow, 7).Value = DataList("DisabledUsers")
					End If
					If DataList("DisabledComputers") = "" Then
						objSheet.Cells(intRow, 8).Value = 0
					Else
						objSheet.Cells(intRow, 8).Value = DataList("DisabledComputers")
					End If
					intRow = intRow + 1
				End If
				DataList.MoveNext
			Wend
			intRow = intRow + 1
			objSheet.Cells(intRow, 1).Value = "TOTAL:"
			objSheet.Rows(intRow & ":" & intRow).Font.Bold = True
			objSheet.Rows(intRow & ":" & intRow).Font.ColorIndex = 55
			For intCol = 2 To 8
				strFormula = "=SUM(" & Chr((intCol) + 64) & intStartRow & ":" & Chr((intCol) + 64) & intRow - 2 & ")"
				objSheet.Cells(intRow, intCol).Formula = strFormula
			Next
		Next
		objSheet.Columns.AutoFit
	End Sub
 
	Sub Export_HTML
		strHTML = "<html>"
		strHTML = strHTML & VbCrLf & "<body>"
		strHTML = strHTML & VbCrLf & "<table>"
		strHTML = strHTML & VbCrLf & "	<table width='80%' height='90%' border='2' align='center'>"
		strHTML = strHTML & VbCrLf & "		<tr>"
		strHTML = strHTML & VbCrLf & "			<td colspan='8'><b>Report Date: " & Now & "</b></td>"
		strHTML = strHTML & VbCrLf & "		</tr>"
		strHTML = strHTML & VbCrLf & "		<tr>"
		strHTML = strHTML & VbCrLf & "			<th align='center'>&nbsp;</th>"
		strHTML = strHTML & VbCrLf & "			<th align='center'>Users</th>"
		strHTML = strHTML & VbCrLf & "			<th align='center'>Computers</th>"
		strHTML = strHTML & VbCrLf & "			<th align='center'>Groups</th>"
		strHTML = strHTML & VbCrLf & "			<th align='center'>Mail-Enabled Users</th>"
		strHTML = strHTML & VbCrLf & "			<th align='center'>Mail-Enabled Groups</th>"
		strHTML = strHTML & VbCrLf & "			<th align='center'>Disabled Users</th>"
		strHTML = strHTML & VbCrLf & "			<th align='center'>Disabled Computers</th>"
		strHTML = strHTML & VbCrLf & "		</tr>"
 
		Const adVarChar = 200
		Const adBigInt = 20
		Const MaxCharacters = 255	
		Set DataList = CreateObject("ADOR.Recordset")
		DataList.Fields.Append "OU", adVarChar, MaxCharacters
		DataList.Fields.Append "Users", adBigInt
		DataList.Fields.Append "Computers", adBigInt
		DataList.Fields.Append "Groups", adBigInt
		DataList.Fields.Append "MailEnabledUsers", adBigInt
		DataList.Fields.Append "MailEnabledGroups", adBigInt
		DataList.Fields.Append "DisabledUsers", adBigInt
		DataList.Fields.Append "DisabledComputers", adBigInt
		
		DataList.Open
		
		' Users
		For Each objEntry In lst_Users.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Users") = 1
				DataList.Update
			Else
				DataList("Users") = CInt(DataList("Users")) + 1
			End If
		Next
		
		' Computers
		For Each objEntry In lst_Computers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Computers") = 1
				DataList.Update
			Else
				DataList("Computers") = CInt(DataList("Computers")) + 1
			End If
		Next
 
		' Groups
		For Each objEntry In lst_groups.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Groups") = 1
				DataList.Update
			Else
				DataList("Groups") = CInt(DataList("Groups")) + 1
			End If
		Next
 
		' Mail-Enalbed Users
		For Each objEntry In lst_mailenabledusers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("MailEnabledUsers") = 1
				DataList.Update
			Else
				DataList("MailEnabledUsers") = CInt(DataList("MailEnabledUsers")) + 1
			End If
		Next
 
		' Mail-Enalbed Groups
		For Each objEntry In lst_mailenabledgroups.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("MailEnabledGroups") = 1
				DataList.Update
			Else
				DataList("MailEnabledGroups") = CInt(DataList("MailEnabledGroups")) + 1
			End If
		Next
 
		' Disabled Users
		For Each objEntry In lst_disabledusers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("DisabledUsers") = 1
				DataList.Update
			Else
				DataList("DisabledUsers") = CInt(DataList("DisabledUsers")) + 1
			End If
		Next
 
		' Disabled Computers
		For Each objEntry In lst_disabledcomputers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("DisabledComputers") = 1
				DataList.Update
			Else
				DataList("DisabledComputers") = CInt(DataList("DisabledComputers")) + 1
			End If
		Next
 
		' Output
		DataList.filter = ""
		DataList.Sort = "OU"
		If Not DataList.BOF Then DataList.MoveFirst
		' Create a dictionary object of the selected OUs to segment the report with
		Set objOUs = CreateObject("Scripting.Dictionary")
		For Each strSelectedOU In Split(span_sitefilter.InnerHTML, "<BR>")
			arrOU = Split(strSelectedOU, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			objOUs.Add LCase(strOU), 0
		Next
		For Each strSelectedOU In objOUs
			strHTML = strHTML & VbCrLf & "		<tr>"
			strHTML = strHTML & VbCrLf & "			<td colspan='8'>&nbsp;</td>"
			strHTML = strHTML & VbCrLf & "		</tr>"
			strHTML = strHTML & VbCrLf & "		<tr>"
			strHTML = strHTML & VbCrLf & "			<td colspan='8'><font color='#333399'><b>OU with Sub OU's if they exist</b></font></td>"
			strHTML = strHTML & VbCrLf & "		</tr>"
			intUsersTotal = 0
			intComputersTotal = 0
			intGroupsTotal = 0
			intMailEnabledUsersTotal = 0
			intMailEnabledGroupsTotal = 0
			intDisabledUsersTotal = 0
			intDisabledComputersTotal = 0
			DataList.MoveFirst
			While Not DataList.EOF
				If InStr(LCase(DataList("OU")), LCase(strSelectedOU)) > 0 Then
					strHTML = strHTML & VbCrLf & "		<tr>"
					strHTML = strHTML & VbCrLf & "			<td>" & DataList("OU") & "</td>"
					If DataList("Users") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("Users") & "</td>"
						intUsersTotal = intUsersTotal + CInt(DataList("Users"))
					End If
					If DataList("Computers") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("Computers") & "</td>"
						intComputersTotal = intComputersTotal + CInt(DataList("Computers"))
					End If
					If DataList("Groups") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("Groups") & "</td>"
						intGroupsTotal = intGroupsTotal + CInt(DataList("Groups"))
					End If
					If DataList("MailEnabledUsers") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("MailEnabledUsers") & "</td>"
						intMailEnabledUsersTotal = intMailEnabledUsersTotal + CInt(DataList("MailEnabledUsers"))
					End If
					If DataList("MailEnabledGroups") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("MailEnabledGroups") & "</td>"
						intMailEnabledGroupsTotal = intMailEnabledGroupsTotal + CInt(DataList("MailEnabledGroups"))
					End If
					If DataList("DisabledUsers") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("DisabledUsers") & "</td>"
						intDisabledUsersTotal = intDisabledUsersTotal + CInt(DataList("DisabledUsers"))
					End If
					If DataList("DisabledComputers") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("DisabledComputers") & "</td>"
						intDisabledComputersTotal = intDisabledComputersTotal + CInt(DataList("DisabledComputers"))
					End If
					strHTML = strHTML & VbCrLf & "		</tr>"
				End If
				DataList.MoveNext
			Wend
			strHTML = strHTML & VbCrLf & "		<tr><td colspan='8'>&nbsp;</td></tr>"
			strHTML = strHTML & VbCrLf & "		<tr>"
			strHTML = strHTML & VbCrLf & "			<td><font color='#333399'><b>TOTAL:</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intUsersTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intComputersTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intGroupsTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intMailEnabledUsersTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intMailEnabledGroupsTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intDisabledUsersTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intDisabledComputersTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "		</tr>"
		Next
		strHTML = strHTML & VbCrLf & "	</table>"
		strHTML = strHTML & VbCrLf & "</body>"
		strHTML = strHTML & VbCrLf & "</html>"
		Set objFSO = CreateObject("Scripting.FileSystemObject")
		strHTMLFile = "HTML_Report_" & Year(Date) & Right("0" & Month(Date), 2) & Right("0" & Day(Date), 2) & Right("0" & Hour(Time), 2) & Right("0" & Minute(Time), 2) & Right("0" & Second(Time), 2) & ".html"
		Set objHTML = objFSO.CreateTextFile(strHTMLFile, True)
		objHTML.Write strHTML
		objHTML.Close
		Set objShell = CreateObject("WScript.Shell")
		objShell.Run strHTMLFile, 1, False
	End Sub
 
</script>
<body style="background-color:#B0C4DE;" onkeypress='vbs:Default_Buttons'>
	<table height="90%" width= "90%" border="0" align="center">
		<tr>
			<td align="center" colspan="3">
				<h2>List OU Users, Computers, and Groups</h2>
			</td>
		</tr>
		<tr>
			<td>
				<b>Site Filter:</b><br>Select multiple OUs with<br>CTRL + Click
			</td>
			<td colspan="2">
			    <select size='8' name='lst_SiteFilter'  onChange='vbs:Show_Selection' multiple="True">
				</select>
			</td>
		</tr>
		<tr>
			<td>
				&nbsp;
			</td>
			<td>
				<input type="checkbox" id="chk_recurse" name="chk_recurse">Recurse Sub OUs
			</td>
			<td>
				<button name="btn_run" id="btn_run" accessKey="G" onclick="vbs:Get_Members"><u>G</u>et Members</button>
			</td>
		</tr>
		<tr>
			<td colspan=3>
				<b>OU Selected:</b>&nbsp&nbsp&nbsp<span id='span_SiteFilter'></span>
			</td>
		</tr>
		<tr>
			<td>
				<b>Users:</b><br>
			    <select size='4' name='lst_users'>
				</select>
				<br><b>Total: </b><span id="span_totalusers"></span>
			</td>
			<td>
				<b>Computers:</b><br>
			    <select size='4' name='lst_computers'>
				</select>
				<br><b>Total: </b><span id="span_totalcomputers"></span>
			</td>
			<td>
				<b>Groups:</b><br>
			    <select size='4' name='lst_groups'>
				</select>
				<br><b>Total: </b><span id="span_totalgroups"></span>
			</td>
		</tr>
		<tr>
			<td>
				<b>Mail-Enabled Users:</b><br>
			    <select size='4' name='lst_mailenabledusers'>
				</select>
				<br><b>Total: </b><span id="span_totalmailusers"></span>
			</td>
			<td>
				&nbsp;
			</td>
			<td>
				<b>Mail-Enabled Groups:</b><br>
			    <select size='4' name='lst_mailenabledgroups'>
				</select>
				<br><b>Total: </b><span id="span_totalmailgroups"></span>
			</td>
		</tr>
		<tr>
			<td>
				<b>Disabled Users:</b><br>
			    <select size='4' name='lst_disabledusers'>
				</select>
				<br><b>Total: </b><span id="span_totaldisabledusers"></span>
			</td>
			<td>
				<b>Disabled Computers:</b><br>
			    <select size='4' name='lst_disabledcomputers'>
				</select>
				<br><b>Total: </b><span id="span_totaldisabledcomputers"></span>
			</td>
			<td>
				&nbsp;
			</td>
		</tr>
	</table>
	<table width= "90%" border="0" align="center">
		<tr align="center">
			<td>
				<button name="btn_exportexcel" id="btn_exportexcel" accessKey="e" onclick="vbs:Export_Excel">Export to <u>E</u>xcel</button>
				&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
				<button name="btn_exporthtml" id="btn_exporthtml" accessKey="h" onclick="vbs:Export_HTML">Export to <u>H</u>TML</button>
			</td>
		</tr>
		<tr align="center">
			<td>
				<button name="btn_exit" id="btn_exit" accessKey="x" onclick="vbs:Exit_HTA">E<u>x</u>it</button>
			</td>
		</tr>
	</table>
</body>
</head>
</html>

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:
557:
558:
559:
560:
561:
562:
563:
564:
565:
566:
567:
568:
569:
570:
571:
572:
573:
574:
575:
576:
577:
578:
579:
580:
581:
582:
583:
584:
585:
586:
587:
588:
589:
590:
591:
592:
593:
594:
595:
596:
597:
598:
599:
600:
601:
602:
603:
604:
605:
606:
607:
608:
609:
610:
611:
612:
613:
614:
615:
616:
617:
618:
619:
620:
621:
622:
623:
624:
625:
626:
627:
628:
629:
630:
631:
632:
633:
634:
635:
636:
637:
638:
639:
640:
641:
642:
643:
644:
645:
646:
647:
648:
649:
650:
651:
652:
653:
654:
655:
656:
657:
658:
659:
660:
661:
662:
663:
664:
665:
666:
667:
668:
669:
670:
671:
672:
673:
674:
675:
676:
677:
678:
679:
680:
681:
682:
683:
684:
685:
686:
687:
688:
689:
690:
691:
692:
693:
694:
695:
696:
697:
698:
699:
700:
701:
702:
703:
704:
705:
706:
707:
708:
709:
710:
711:
712:
713:
714:
715:
716:
717:
718:
719:
720:
721:
722:
723:
724:
725:
726:
727:
728:
729:
730:
731:
732:
733:
734:
735:
736:
737:
738:
739:
740:
741:
742:
743:
744:
745:
746:
747:
748:
749:
750:
751:
752:
753:
754:
755:
756:
757:
758:
759:
760:
761:
762:
763:
764:
765:
766:
767:
768:
769:
770:
771:
772:
773:
774:
775:
776:
777:
778:
779:
780:
781:
782:
783:
784:
785:
786:
787:
788:
789:
790:
791:
792:
793:
794:
795:
796:
797:
798:
799:
800:
801:
802:
803:
804:
805:
806:
807:
808:
809:
810:
811:
812:
813:
814:
815:
816:
817:
818:
819:
820:
821:
822:
823:
824:
825:
826:
827:
828:
829:
830:
831:
832:
833:
834:
835:
836:
837:
838:
839:
840:
841:
842:
843:
844:
845:
846:
847:
848:
849:
850:
851:
852:
853:
854:
855:
856:
857:
858:
859:
860:
861:
862:
863:
864:
865:
866:
867:
868:
869:
870:
871:
872:
873:
874:
875:
876:
877:
878:
879:
880:
881:
882:
883:
884:
885:
886:
887:
888:
889:
890:
891:
892:
893:
894:
895:
896:
897:
898:
899:
900:
901:
902:
903:
904:
905:
906:
907:
908:

Select all Open in new window

by: eperez0968Posted on 2009-11-10 at 17:25:33ID: 25791682

that is so cool on the html export, thank you for that add on.

ok i think there is something confusing the report, it happens only when it is e-mail enabled objects, but when i select a computer OU for example it works fine. i have attached a doc file to show you the error i get.

Error.doc
- 42 KB
Error when i run HTA

by: RobSampsonPosted on 2009-11-10 at 17:34:31ID: 25791708

Hmm, perhaps this is because the entry had already been added to another box. Maybe I have to create another entry, so see if this works. I can't test the mail property because I don't use Exchange.

Regards,

Rob.

<Html>
<Head>
<Title>List OU Users, Computers, and Groups</Title>
 
<HTA:Application
Caption = Yes
Border = Thick
ShowInTaskBar = Yes
SingleInstance = Yes
MaximizeButton = Yes
MinimizeButton = Yes>
 
<script Language = VBScript>
 
	Sub Window_OnLoad
		intWidth = 800
		intHeight = 800
		Me.ResizeTo intWidth, intHeight
		Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
		lst_users.Style.Width = 200
		lst_computers.Style.Width = 200
		lst_groups.Style.Width = 200
		lst_mailenabledusers.Style.Width = 200
		lst_mailenabledgroups.Style.Width = 200
		lst_disabledusers.Style.Width = 200
		lst_disabledcomputers.Style.Width = 200
    	Set objRootDSE = GetObject("LDAP://RootDSE")
    	strBaseConnString = objRootDSE.Get("defaultNamingContext")
		Set objOULevel = GetObject("LDAP://" & strBaseConnString)
		RecurseOUs objOULevel, 0, strBaseConnString
		Show_Selection
	End Sub
 
	Sub Clear_Users
		For intListProgress = 1 To lst_Users.Length
	   		lst_Users.Remove 0
	   	Next
	   	span_totalusers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_Computers
		For intListProgress = 1 To lst_computers.Length
	   		lst_computers.Remove 0
	   	Next
	   	span_totalcomputers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_Groups
		For intListProgress = 1 To lst_groups.Length
	   		lst_groups.Remove 0
	   	Next
	   	span_totalgroups.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_MailEnabledUsers
		For intListProgress = 1 To lst_mailenabledusers.Length
	   		lst_mailenabledusers.Remove 0
	   	Next
	   	span_totalmailusers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_MailEnabledGroups
		For intListProgress = 1 To lst_mailenabledgroups.Length
	   		lst_mailenabledgroups.Remove 0
	   	Next
	   	span_totalmailgroups.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_DisabledUsers
		For intListProgress = 1 To lst_disabledusers.Length
	   		lst_disabledusers.Remove 0
	   	Next
	   	span_totaldisabledusers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_DisabledComputers
		For intListProgress = 1 To lst_disabledcomputers.Length
	   		lst_disabledcomputers.Remove 0
	   	Next
	   	span_totaldisabledcomputers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub RecurseOUs(objOU, intLevel, strBaseConn)
		Dim objOUObject, strConnString, objActiveOption
		For Each objOUObject In objOU
			If UCase(Left(objOUObject.Name, 3)) = "OU=" Then
				strConnString = objOUObject.DistinguishedName
				Set objActiveOption = Document.CreateElement("OPTION")
		    	If intLevel = 0 Then
		    		objActiveOption.Text = Replace(objOUObject.Name, "OU=", "")
		    	Else
		    		objActiveOption.Text = String(intLevel * 4, " ") & "->   " & Replace(objOUObject.Name, "OU=", "")
		    	End If
		    	objActiveOption.Value = strConnString
		    	lst_SiteFilter.Add objActiveOption
				On Error Resume Next
				RecurseOUs GetObject("LDAP://" & strConnString), intLevel + 1, strBaseConn
				If Err.Number <> 0 Then
					MsgBox "Error enumerating " & strConnString
				End If
				Err.Clear
				On Error GoTo 0
			End If
		Next
	End Sub
 
	Sub Show_Selection
		span_SiteFilter.InnerHTML = ""
		For Each objOption In lst_SiteFilter.Options
			If objOption.Selected = True Then
				If span_SiteFilter.InnerHTML = "" Then
					span_SiteFilter.InnerHTML = objOption.Value
				Else
					span_SiteFilter.InnerHTML = span_SiteFilter.InnerHTML & "<BR>" & objOption.Value
				End If
			End If
		Next
	End Sub
 
	Sub Default_Buttons
		If Window.Event.KeyCode = 13 Then
			btn_run.Click
		End If
	End Sub
 
	Sub Exit_HTA
		Window.Close
	End Sub
 
	Sub Get_Members
		Clear_Users
		Clear_Computers
		Clear_Groups
		Clear_MailEnabledUsers
		Clear_MailEnabledGroups
		Clear_DisabledUsers
		Clear_DisabledComputers
		
		Set objConnection2 = CreateObject("ADODB.Connection")
		Set objCommand2 = CreateObject("ADODB.Command")
		objConnection2.Provider = "ADsDSOObject"
		objConnection2.Open "Active Directory Provider"
		Set objCommand2.ActiveConnection = objConnection2
		
		For Each strOU In Split(span_sitefilter.InnerHTML, "<BR>")
			GetOUObjects("LDAP://" & strOU)
		Next
		
		span_totalusers.InnerHTML = "<b>" & lst_users.Length & "</b>"
		span_totalcomputers.InnerHTML = "<b>" & lst_computers.Length & "</b>"
		span_totalgroups.InnerHTML = "<b>" & lst_groups.Length & "</b>"
		span_totalmailusers.InnerHTML = "<b>" & lst_mailenabledusers.Length & "</b>"
		span_totalmailgroups.InnerHTML = "<b>" & lst_mailenabledgroups.Length & "</b>"
		span_totaldisabledusers.InnerHTML = "<b>" & lst_disabledusers.Length & "</b>"
		span_totaldisabledcomputers.InnerHTML = "<b>" & lst_disabledcomputers.Length & "</b>"
	End Sub
	
	Sub GetOUObjects(strLDAPPath)
		Const ADS_UF_ACCOUNTDISABLE = 2
		Set objOU = GetObject(strLDAPPath)
		For Each objObject In objOU
			Set objMember = Document.CreateElement("OPTION")
			objMember.Text = objObject.cn
	        objMember.Value = objObject.distinguishedname
			If LCase(objObject.Class) = "user" Then
				intUAC = objObject.userAccountControl
				If intUAC And ADS_UF_ACCOUNTDISABLE Then
					lst_disabledusers.Add objMember, 0
				Else
					lst_users.Add objMember, 0
				End If
				strMail = ""
				On Error Resume Next
				strMail = objObject.mail
				Err.Clear
				On Error GoTo 0
				If strMail <> "" And IsNull(objObject.mail) = False Then
					Set objMember = Document.CreateElement("OPTION")
					objMember.Text = objObject.cn
			        objMember.Value = objObject.distinguishedname
					lst_mailenabledusers.Add objMember, 0
				End If
				Err.Clear
				On Error GoTo 0
			ElseIf LCase(objObject.Class) = "computer" Then
				intUAC = objObject.userAccountControl
				If intUAC And ADS_UF_ACCOUNTDISABLE Then
					lst_disabledcomputers.Add objMember, 0
				Else
					lst_computers.Add objMember, 0
				End If
			ElseIf LCase(objObject.Class) = "group" Then
				lst_groups.Add objMember, 0
				strMail = ""
				On Error Resume Next
				strMail = objObject.mail
				Err.Clear
				On Error GoTo 0
				If strMail <> "" And IsNull(objObject.mail) = False Then
					Set objMember = Document.CreateElement("OPTION")
					objMember.Text = objObject.cn
			        objMember.Value = objObject.distinguishedname
					lst_mailenabledgroups.Add objMember, 0
				End If
				Err.Clear
				On Error GoTo 0
			End If
			If chk_recurse.checked = True Then
				GetOUObjects objObject.adsPath
			End If
		Next
	End Sub
	
	Sub Export_Excel
		Set objExcel = CreateObject("Excel.Application")
		Set objWB = objExcel.Workbooks.Add
		Set objSheet = objWB.Sheets(1)
		objExcel.Visible = True
		objSheet.Cells(1, 1).Value = "Report Date " & Date
		objSheet.Cells(1, 1).Font.Bold = True
		objSheet.Cells(2, 2).Value = "Users"
		objSheet.Cells(2, 3).Value = "Computers"
		objSheet.Cells(2, 4).Value = "Groups"
		objSheet.Cells(2, 5).Value = "Mail-Enabled Users"
		objSheet.Cells(2, 6).Value = "Mail-Enabled Groups"
		objSheet.Cells(2, 7).Value = "Disabled Users"
		objSheet.Cells(2, 8).Value = "Disabled Computers"
		objSheet.Rows("2:2").Font.Bold = True
 
		Const adVarChar = 200
		Const adBigInt = 20
		Const MaxCharacters = 255	
		Set DataList = CreateObject("ADOR.Recordset")
		DataList.Fields.Append "OU", adVarChar, MaxCharacters
		DataList.Fields.Append "Users", adBigInt
		DataList.Fields.Append "Computers", adBigInt
		DataList.Fields.Append "Groups", adBigInt
		DataList.Fields.Append "MailEnabledUsers", adBigInt
		DataList.Fields.Append "MailEnabledGroups", adBigInt
		DataList.Fields.Append "DisabledUsers", adBigInt
		DataList.Fields.Append "DisabledComputers", adBigInt
		
		DataList.Open
		
		' Users
		For Each objEntry In lst_Users.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Users") = 1
				DataList.Update
			Else
				DataList("Users") = CInt(DataList("Users")) + 1
			End If
		Next
		
		' Computers
		For Each objEntry In lst_Computers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Computers") = 1
				DataList.Update
			Else
				DataList("Computers") = CInt(DataList("Computers")) + 1
			End If
		Next
 
		' Groups
		For Each objEntry In lst_groups.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Groups") = 1
				DataList.Update
			Else
				DataList("Groups") = CInt(DataList("Groups")) + 1
			End If
		Next
 
		' Mail-Enalbed Users
		For Each objEntry In lst_mailenabledusers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("MailEnabledUsers") = 1
				DataList.Update
			Else
				DataList("MailEnabledUsers") = CInt(DataList("MailEnabledUsers")) + 1
			End If
		Next
 
		' Mail-Enalbed Groups
		For Each objEntry In lst_mailenabledgroups.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("MailEnabledGroups") = 1
				DataList.Update
			Else
				DataList("MailEnabledGroups") = CInt(DataList("MailEnabledGroups")) + 1
			End If
		Next
 
		' Disabled Users
		For Each objEntry In lst_disabledusers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("DisabledUsers") = 1
				DataList.Update
			Else
				DataList("DisabledUsers") = CInt(DataList("DisabledUsers")) + 1
			End If
		Next
 
		' Disabled Computers
		For Each objEntry In lst_disabledcomputers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("DisabledComputers") = 1
				DataList.Update
			Else
				DataList("DisabledComputers") = CInt(DataList("DisabledComputers")) + 1
			End If
		Next
 
		' Output
		DataList.filter = ""
		DataList.Sort = "OU"
		If Not DataList.BOF Then DataList.MoveFirst
		' Create a dictionary object of the selected OUs to segment the report with
		Set objOUs = CreateObject("Scripting.Dictionary")
		For Each strSelectedOU In Split(span_sitefilter.InnerHTML, "<BR>")
			arrOU = Split(strSelectedOU, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			objOUs.Add LCase(strOU), 0
		Next
		intRow = 2
		For Each strSelectedOU In objOUs
			intRow = intRow + 2
			objSheet.Cells(intRow, 1).Value = "OU with Sub OU's if they exist"
			objSheet.Cells(intRow, 1).Font.ColorIndex = 55
			objSheet.Cells(intRow, 1).Font.Bold = True
			intRow = intRow + 1
			intStartRow = intRow
			DataList.MoveFirst
			While Not DataList.EOF
				If InStr(LCase(DataList("OU")), LCase(strSelectedOU)) > 0 Then
					For intCol = 2 To 8
						objSheet.Cells(intRow, intCol).Value = 0
					Next
					objSheet.Cells(intRow, 1).Value = DataList("OU")
					If DataList("Users") = "" Then
						objSheet.Cells(intRow, 2).Value = 0
					Else
						objSheet.Cells(intRow, 2).Value = DataList("Users")
					End If
					If DataList("Computers") = "" Then
						objSheet.Cells(intRow, 3).Value = 0
					Else
						objSheet.Cells(intRow, 3).Value = DataList("Computers")
					End If
					If DataList("Groups") = "" Then
						objSheet.Cells(intRow, 4).Value = 0
					Else
						objSheet.Cells(intRow, 4).Value = DataList("Groups")
					End If
					If DataList("MailEnabledUsers") = "" Then
						objSheet.Cells(intRow, 5).Value = 0
					Else
						objSheet.Cells(intRow, 5).Value = DataList("MailEnabledUsers")
					End If
					If DataList("MailEnabledGroups") = "" Then
						objSheet.Cells(intRow, 6).Value = 0
					Else
						objSheet.Cells(intRow, 6).Value = DataList("MailEnabledGroups")
					End If
					If DataList("DisabledUsers") = "" Then
						objSheet.Cells(intRow, 7).Value = 0
					Else
						objSheet.Cells(intRow, 7).Value = DataList("DisabledUsers")
					End If
					If DataList("DisabledComputers") = "" Then
						objSheet.Cells(intRow, 8).Value = 0
					Else
						objSheet.Cells(intRow, 8).Value = DataList("DisabledComputers")
					End If
					intRow = intRow + 1
				End If
				DataList.MoveNext
			Wend
			intRow = intRow + 1
			objSheet.Cells(intRow, 1).Value = "TOTAL:"
			objSheet.Rows(intRow & ":" & intRow).Font.Bold = True
			objSheet.Rows(intRow & ":" & intRow).Font.ColorIndex = 55
			For intCol = 2 To 8
				strFormula = "=SUM(" & Chr((intCol) + 64) & intStartRow & ":" & Chr((intCol) + 64) & intRow - 2 & ")"
				objSheet.Cells(intRow, intCol).Formula = strFormula
			Next
		Next
		objSheet.Columns.AutoFit
	End Sub
 
	Sub Export_HTML
		strHTML = "<html>"
		strHTML = strHTML & VbCrLf & "<body>"
		strHTML = strHTML & VbCrLf & "<table>"
		strHTML = strHTML & VbCrLf & "	<table width='80%' height='90%' border='2' align='center'>"
		strHTML = strHTML & VbCrLf & "		<tr>"
		strHTML = strHTML & VbCrLf & "			<td colspan='8'><b>Report Date: " & Now & "</b></td>"
		strHTML = strHTML & VbCrLf & "		</tr>"
		strHTML = strHTML & VbCrLf & "		<tr>"
		strHTML = strHTML & VbCrLf & "			<th align='center'>&nbsp;</th>"
		strHTML = strHTML & VbCrLf & "			<th align='center'>Users</th>"
		strHTML = strHTML & VbCrLf & "			<th align='center'>Computers</th>"
		strHTML = strHTML & VbCrLf & "			<th align='center'>Groups</th>"
		strHTML = strHTML & VbCrLf & "			<th align='center'>Mail-Enabled Users</th>"
		strHTML = strHTML & VbCrLf & "			<th align='center'>Mail-Enabled Groups</th>"
		strHTML = strHTML & VbCrLf & "			<th align='center'>Disabled Users</th>"
		strHTML = strHTML & VbCrLf & "			<th align='center'>Disabled Computers</th>"
		strHTML = strHTML & VbCrLf & "		</tr>"
 
		Const adVarChar = 200
		Const adBigInt = 20
		Const MaxCharacters = 255	
		Set DataList = CreateObject("ADOR.Recordset")
		DataList.Fields.Append "OU", adVarChar, MaxCharacters
		DataList.Fields.Append "Users", adBigInt
		DataList.Fields.Append "Computers", adBigInt
		DataList.Fields.Append "Groups", adBigInt
		DataList.Fields.Append "MailEnabledUsers", adBigInt
		DataList.Fields.Append "MailEnabledGroups", adBigInt
		DataList.Fields.Append "DisabledUsers", adBigInt
		DataList.Fields.Append "DisabledComputers", adBigInt
		
		DataList.Open
		
		' Users
		For Each objEntry In lst_Users.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Users") = 1
				DataList.Update
			Else
				DataList("Users") = CInt(DataList("Users")) + 1
			End If
		Next
		
		' Computers
		For Each objEntry In lst_Computers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Computers") = 1
				DataList.Update
			Else
				DataList("Computers") = CInt(DataList("Computers")) + 1
			End If
		Next
 
		' Groups
		For Each objEntry In lst_groups.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Groups") = 1
				DataList.Update
			Else
				DataList("Groups") = CInt(DataList("Groups")) + 1
			End If
		Next
 
		' Mail-Enalbed Users
		For Each objEntry In lst_mailenabledusers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("MailEnabledUsers") = 1
				DataList.Update
			Else
				DataList("MailEnabledUsers") = CInt(DataList("MailEnabledUsers")) + 1
			End If
		Next
 
		' Mail-Enalbed Groups
		For Each objEntry In lst_mailenabledgroups.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("MailEnabledGroups") = 1
				DataList.Update
			Else
				DataList("MailEnabledGroups") = CInt(DataList("MailEnabledGroups")) + 1
			End If
		Next
 
		' Disabled Users
		For Each objEntry In lst_disabledusers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("DisabledUsers") = 1
				DataList.Update
			Else
				DataList("DisabledUsers") = CInt(DataList("DisabledUsers")) + 1
			End If
		Next
 
		' Disabled Computers
		For Each objEntry In lst_disabledcomputers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("DisabledComputers") = 1
				DataList.Update
			Else
				DataList("DisabledComputers") = CInt(DataList("DisabledComputers")) + 1
			End If
		Next
 
		' Output
		DataList.filter = ""
		DataList.Sort = "OU"
		If Not DataList.BOF Then DataList.MoveFirst
		' Create a dictionary object of the selected OUs to segment the report with
		Set objOUs = CreateObject("Scripting.Dictionary")
		For Each strSelectedOU In Split(span_sitefilter.InnerHTML, "<BR>")
			arrOU = Split(strSelectedOU, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			objOUs.Add LCase(strOU), 0
		Next
		For Each strSelectedOU In objOUs
			strHTML = strHTML & VbCrLf & "		<tr>"
			strHTML = strHTML & VbCrLf & "			<td colspan='8'>&nbsp;</td>"
			strHTML = strHTML & VbCrLf & "		</tr>"
			strHTML = strHTML & VbCrLf & "		<tr>"
			strHTML = strHTML & VbCrLf & "			<td colspan='8'><font color='#333399'><b>OU with Sub OU's if they exist</b></font></td>"
			strHTML = strHTML & VbCrLf & "		</tr>"
			intUsersTotal = 0
			intComputersTotal = 0
			intGroupsTotal = 0
			intMailEnabledUsersTotal = 0
			intMailEnabledGroupsTotal = 0
			intDisabledUsersTotal = 0
			intDisabledComputersTotal = 0
			DataList.MoveFirst
			While Not DataList.EOF
				If InStr(LCase(DataList("OU")), LCase(strSelectedOU)) > 0 Then
					strHTML = strHTML & VbCrLf & "		<tr>"
					strHTML = strHTML & VbCrLf & "			<td>" & DataList("OU") & "</td>"
					If DataList("Users") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("Users") & "</td>"
						intUsersTotal = intUsersTotal + CInt(DataList("Users"))
					End If
					If DataList("Computers") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("Computers") & "</td>"
						intComputersTotal = intComputersTotal + CInt(DataList("Computers"))
					End If
					If DataList("Groups") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("Groups") & "</td>"
						intGroupsTotal = intGroupsTotal + CInt(DataList("Groups"))
					End If
					If DataList("MailEnabledUsers") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("MailEnabledUsers") & "</td>"
						intMailEnabledUsersTotal = intMailEnabledUsersTotal + CInt(DataList("MailEnabledUsers"))
					End If
					If DataList("MailEnabledGroups") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("MailEnabledGroups") & "</td>"
						intMailEnabledGroupsTotal = intMailEnabledGroupsTotal + CInt(DataList("MailEnabledGroups"))
					End If
					If DataList("DisabledUsers") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("DisabledUsers") & "</td>"
						intDisabledUsersTotal = intDisabledUsersTotal + CInt(DataList("DisabledUsers"))
					End If
					If DataList("DisabledComputers") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("DisabledComputers") & "</td>"
						intDisabledComputersTotal = intDisabledComputersTotal + CInt(DataList("DisabledComputers"))
					End If
					strHTML = strHTML & VbCrLf & "		</tr>"
				End If
				DataList.MoveNext
			Wend
			strHTML = strHTML & VbCrLf & "		<tr><td colspan='8'>&nbsp;</td></tr>"
			strHTML = strHTML & VbCrLf & "		<tr>"
			strHTML = strHTML & VbCrLf & "			<td><font color='#333399'><b>TOTAL:</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intUsersTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intComputersTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intGroupsTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intMailEnabledUsersTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intMailEnabledGroupsTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intDisabledUsersTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intDisabledComputersTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "		</tr>"
		Next
		strHTML = strHTML & VbCrLf & "	</table>"
		strHTML = strHTML & VbCrLf & "</body>"
		strHTML = strHTML & VbCrLf & "</html>"
		Set objFSO = CreateObject("Scripting.FileSystemObject")
		strHTMLFile = "HTML_Report_" & Year(Date) & Right("0" & Month(Date), 2) & Right("0" & Day(Date), 2) & Right("0" & Hour(Time), 2) & Right("0" & Minute(Time), 2) & Right("0" & Second(Time), 2) & ".html"
		Set objHTML = objFSO.CreateTextFile(strHTMLFile, True)
		objHTML.Write strHTML
		objHTML.Close
		Set objShell = CreateObject("WScript.Shell")
		objShell.Run strHTMLFile, 1, False
	End Sub
 
</script>
<body style="background-color:#B0C4DE;" onkeypress='vbs:Default_Buttons'>
	<table height="90%" width= "90%" border="0" align="center">
		<tr>
			<td align="center" colspan="3">
				<h2>List OU Users, Computers, and Groups</h2>
			</td>
		</tr>
		<tr>
			<td>
				<b>Site Filter:</b><br>Select multiple OUs with<br>CTRL + Click
			</td>
			<td colspan="2">
			    <select size='8' name='lst_SiteFilter'  onChange='vbs:Show_Selection' multiple="True">
				</select>
			</td>
		</tr>
		<tr>
			<td>
				&nbsp;
			</td>
			<td>
				<input type="checkbox" id="chk_recurse" name="chk_recurse">Recurse Sub OUs
			</td>
			<td>
				<button name="btn_run" id="btn_run" accessKey="G" onclick="vbs:Get_Members"><u>G</u>et Members</button>
			</td>
		</tr>
		<tr>
			<td colspan=3>
				<b>OU Selected:</b>&nbsp&nbsp&nbsp<span id='span_SiteFilter'></span>
			</td>
		</tr>
		<tr>
			<td>
				<b>Users:</b><br>
			    <select size='4' name='lst_users'>
				</select>
				<br><b>Total: </b><span id="span_totalusers"></span>
			</td>
			<td>
				<b>Computers:</b><br>
			    <select size='4' name='lst_computers'>
				</select>
				<br><b>Total: </b><span id="span_totalcomputers"></span>
			</td>
			<td>
				<b>Groups:</b><br>
			    <select size='4' name='lst_groups'>
				</select>
				<br><b>Total: </b><span id="span_totalgroups"></span>
			</td>
		</tr>
		<tr>
			<td>
				<b>Mail-Enabled Users:</b><br>
			    <select size='4' name='lst_mailenabledusers'>
				</select>
				<br><b>Total: </b><span id="span_totalmailusers"></span>
			</td>
			<td>
				&nbsp;
			</td>
			<td>
				<b>Mail-Enabled Groups:</b><br>
			    <select size='4' name='lst_mailenabledgroups'>
				</select>
				<br><b>Total: </b><span id="span_totalmailgroups"></span>
			</td>
		</tr>
		<tr>
			<td>
				<b>Disabled Users:</b><br>
			    <select size='4' name='lst_disabledusers'>
				</select>
				<br><b>Total: </b><span id="span_totaldisabledusers"></span>
			</td>
			<td>
				<b>Disabled Computers:</b><br>
			    <select size='4' name='lst_disabledcomputers'>
				</select>
				<br><b>Total: </b><span id="span_totaldisabledcomputers"></span>
			</td>
			<td>
				&nbsp;
			</td>
		</tr>
	</table>
	<table width= "90%" border="0" align="center">
		<tr align="center">
			<td>
				<button name="btn_exportexcel" id="btn_exportexcel" accessKey="e" onclick="vbs:Export_Excel">Export to <u>E</u>xcel</button>
				&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
				<button name="btn_exporthtml" id="btn_exporthtml" accessKey="h" onclick="vbs:Export_HTML">Export to <u>H</u>TML</button>
			</td>
		</tr>
		<tr align="center">
			<td>
				<button name="btn_exit" id="btn_exit" accessKey="x" onclick="vbs:Exit_HTA">E<u>x</u>it</button>
			</td>
		</tr>
	</table>
</body>
</head>
</html>

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:
557:
558:
559:
560:
561:
562:
563:
564:
565:
566:
567:
568:
569:
570:
571:
572:
573:
574:
575:
576:
577:
578:
579:
580:
581:
582:
583:
584:
585:
586:
587:
588:
589:
590:
591:
592:
593:
594:
595:
596:
597:
598:
599:
600:
601:
602:
603:
604:
605:
606:
607:
608:
609:
610:
611:
612:
613:
614:
615:
616:
617:
618:
619:
620:
621:
622:
623:
624:
625:
626:
627:
628:
629:
630:
631:
632:
633:
634:
635:
636:
637:
638:
639:
640:
641:
642:
643:
644:
645:
646:
647:
648:
649:
650:
651:
652:
653:
654:
655:
656:
657:
658:
659:
660:
661:
662:
663:
664:
665:
666:
667:
668:
669:
670:
671:
672:
673:
674:
675:
676:
677:
678:
679:
680:
681:
682:
683:
684:
685:
686:
687:
688:
689:
690:
691:
692:
693:
694:
695:
696:
697:
698:
699:
700:
701:
702:
703:
704:
705:
706:
707:
708:
709:
710:
711:
712:
713:
714:
715:
716:
717:
718:
719:
720:
721:
722:
723:
724:
725:
726:
727:
728:
729:
730:
731:
732:
733:
734:
735:
736:
737:
738:
739:
740:
741:
742:
743:
744:
745:
746:
747:
748:
749:
750:
751:
752:
753:
754:
755:
756:
757:
758:
759:
760:
761:
762:
763:
764:
765:
766:
767:
768:
769:
770:
771:
772:
773:
774:
775:
776:
777:
778:
779:
780:
781:
782:
783:
784:
785:
786:
787:
788:
789:
790:
791:
792:
793:
794:
795:
796:
797:
798:
799:
800:
801:
802:
803:
804:
805:
806:
807:
808:
809:
810:
811:
812:
813:
814:
815:
816:
817:
818:
819:
820:
821:
822:
823:
824:
825:
826:
827:
828:
829:
830:
831:
832:
833:
834:
835:
836:
837:
838:
839:
840:
841:
842:
843:
844:
845:
846:
847:
848:
849:
850:
851:
852:
853:
854:
855:
856:
857:
858:
859:
860:
861:
862:
863:
864:
865:
866:
867:
868:
869:
870:
871:
872:
873:
874:
875:
876:
877:
878:
879:
880:
881:
882:
883:
884:
885:
886:
887:
888:
889:
890:
891:
892:
893:
894:
895:
896:
897:
898:
899:
900:
901:
902:
903:
904:
905:
906:
907:
908:
909:
910:
911:
912:
913:
914:

Select all Open in new window

by: eperez0968Posted on 2009-11-10 at 17:45:08ID: 25791743

i am going to try it right now

by: eperez0968Posted on 2009-11-10 at 18:10:58ID: 25791830

I THINK YOU DID IT YEA!!!!!!!!!! :) :)

my connection keeps timing out, i am going to verify this at work in the morning, i will let you know, but i feel really good about this. YOU JUST MADE MY DAY, thanks and i will give the the results in the morning. Crossing my fingers here :)

by: eperez0968Posted on 2009-11-10 at 18:21:32ID: 25791866

yep keeps timing out from my home connection our AD is very huge with OU's Groups....etc........ over 15,0000 objects, but i will let you know in the morning

by: RobSampsonPosted on 2009-11-10 at 18:31:59ID: 25791910

Wow! That's a lot of objects! You could test on a deeper sub OU and untick the recursion....that should be less objects....but anyway, no hurry, let me know how you go.

Regards,

Rob.

by: eperez0968Posted on 2009-11-11 at 04:56:34ID: 25794583

Hey Rob,
YOU DID IT!!!, it is working perfectly no problems. PAT yourself on the back for this one, this is really great and looks good, From this script and a good imagination you can build alot of intereting things from this perticular script :)
would it be to much to ask to add one more request, i am just trying to pretty up the excel and HTML report, i have attached a before and after so you can see what i am talking about. let me know if it is too much trouble it is ok, you have done alot for me and i will award you the points. thank you again

Eric

Before.xls
- 20 KB
Before
After.xls
- 23 KB
After

by: RobSampsonPosted on 2009-11-11 at 13:09:04ID: 25799081

You just want to duplicate the header line? Sure, I can do that. I'll be able to provide that later today.

>> you can build alot of intereting things

Absolutely. There's an enormous amount of information gathering you can do in the AD (although unfortunately not everything). It's just a matter of having the time to build it.

Rob.

by: RobSampsonPosted on 2009-11-11 at 13:53:08ID: 25799517

Actually, I had time to do it this morning. Here you go.

Regards,

Rob.

<Html>
<Head>
<Title>List OU Users, Computers, and Groups</Title>
 
<HTA:Application
Caption = Yes
Border = Thick
ShowInTaskBar = Yes
SingleInstance = Yes
MaximizeButton = Yes
MinimizeButton = Yes>
 
<script Language = VBScript>
 
	Sub Window_OnLoad
		intWidth = 800
		intHeight = 800
		Me.ResizeTo intWidth, intHeight
		Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
		lst_users.Style.Width = 200
		lst_computers.Style.Width = 200
		lst_groups.Style.Width = 200
		lst_mailenabledusers.Style.Width = 200
		lst_mailenabledgroups.Style.Width = 200
		lst_disabledusers.Style.Width = 200
		lst_disabledcomputers.Style.Width = 200
    	Set objRootDSE = GetObject("LDAP://RootDSE")
    	strBaseConnString = objRootDSE.Get("defaultNamingContext")
		Set objOULevel = GetObject("LDAP://" & strBaseConnString)
		RecurseOUs objOULevel, 0, strBaseConnString
		Show_Selection
	End Sub
 
	Sub Clear_Users
		For intListProgress = 1 To lst_Users.Length
	   		lst_Users.Remove 0
	   	Next
	   	span_totalusers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_Computers
		For intListProgress = 1 To lst_computers.Length
	   		lst_computers.Remove 0
	   	Next
	   	span_totalcomputers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_Groups
		For intListProgress = 1 To lst_groups.Length
	   		lst_groups.Remove 0
	   	Next
	   	span_totalgroups.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_MailEnabledUsers
		For intListProgress = 1 To lst_mailenabledusers.Length
	   		lst_mailenabledusers.Remove 0
	   	Next
	   	span_totalmailusers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_MailEnabledGroups
		For intListProgress = 1 To lst_mailenabledgroups.Length
	   		lst_mailenabledgroups.Remove 0
	   	Next
	   	span_totalmailgroups.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_DisabledUsers
		For intListProgress = 1 To lst_disabledusers.Length
	   		lst_disabledusers.Remove 0
	   	Next
	   	span_totaldisabledusers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_DisabledComputers
		For intListProgress = 1 To lst_disabledcomputers.Length
	   		lst_disabledcomputers.Remove 0
	   	Next
	   	span_totaldisabledcomputers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub RecurseOUs(objOU, intLevel, strBaseConn)
		Dim objOUObject, strConnString, objActiveOption
		For Each objOUObject In objOU
			If UCase(Left(objOUObject.Name, 3)) = "OU=" Then
				strConnString = objOUObject.DistinguishedName
				Set objActiveOption = Document.CreateElement("OPTION")
		    	If intLevel = 0 Then
		    		objActiveOption.Text = Replace(objOUObject.Name, "OU=", "")
		    	Else
		    		objActiveOption.Text = String(intLevel * 4, " ") & "->   " & Replace(objOUObject.Name, "OU=", "")
		    	End If
		    	objActiveOption.Value = strConnString
		    	lst_SiteFilter.Add objActiveOption
				On Error Resume Next
				RecurseOUs GetObject("LDAP://" & strConnString), intLevel + 1, strBaseConn
				If Err.Number <> 0 Then
					MsgBox "Error enumerating " & strConnString
				End If
				Err.Clear
				On Error GoTo 0
			End If
		Next
	End Sub
 
	Sub Show_Selection
		span_SiteFilter.InnerHTML = ""
		For Each objOption In lst_SiteFilter.Options
			If objOption.Selected = True Then
				If span_SiteFilter.InnerHTML = "" Then
					span_SiteFilter.InnerHTML = objOption.Value
				Else
					span_SiteFilter.InnerHTML = span_SiteFilter.InnerHTML & "<BR>" & objOption.Value
				End If
			End If
		Next
	End Sub
 
	Sub Default_Buttons
		If Window.Event.KeyCode = 13 Then
			btn_run.Click
		End If
	End Sub
 
	Sub Exit_HTA
		Window.Close
	End Sub
 
	Sub Get_Members
		Clear_Users
		Clear_Computers
		Clear_Groups
		Clear_MailEnabledUsers
		Clear_MailEnabledGroups
		Clear_DisabledUsers
		Clear_DisabledComputers
		
		Set objConnection2 = CreateObject("ADODB.Connection")
		Set objCommand2 = CreateObject("ADODB.Command")
		objConnection2.Provider = "ADsDSOObject"
		objConnection2.Open "Active Directory Provider"
		Set objCommand2.ActiveConnection = objConnection2
		
		For Each strOU In Split(span_sitefilter.InnerHTML, "<BR>")
			GetOUObjects("LDAP://" & strOU)
		Next
		
		span_totalusers.InnerHTML = "<b>" & lst_users.Length & "</b>"
		span_totalcomputers.InnerHTML = "<b>" & lst_computers.Length & "</b>"
		span_totalgroups.InnerHTML = "<b>" & lst_groups.Length & "</b>"
		span_totalmailusers.InnerHTML = "<b>" & lst_mailenabledusers.Length & "</b>"
		span_totalmailgroups.InnerHTML = "<b>" & lst_mailenabledgroups.Length & "</b>"
		span_totaldisabledusers.InnerHTML = "<b>" & lst_disabledusers.Length & "</b>"
		span_totaldisabledcomputers.InnerHTML = "<b>" & lst_disabledcomputers.Length & "</b>"
	End Sub
	
	Sub GetOUObjects(strLDAPPath)
		Const ADS_UF_ACCOUNTDISABLE = 2
		Set objOU = GetObject(strLDAPPath)
		For Each objObject In objOU
			Set objMember = Document.CreateElement("OPTION")
			objMember.Text = objObject.cn
	        objMember.Value = objObject.distinguishedname
			If LCase(objObject.Class) = "user" Then
				intUAC = objObject.userAccountControl
				If intUAC And ADS_UF_ACCOUNTDISABLE Then
					lst_disabledusers.Add objMember, 0
				Else
					lst_users.Add objMember, 0
				End If
				strMail = ""
				On Error Resume Next
				strMail = objObject.mail
				Err.Clear
				On Error GoTo 0
				If strMail <> "" And IsNull(objObject.mail) = False Then
					Set objMember = Document.CreateElement("OPTION")
					objMember.Text = objObject.cn
			        objMember.Value = objObject.distinguishedname
					lst_mailenabledusers.Add objMember, 0
				End If
				Err.Clear
				On Error GoTo 0
			ElseIf LCase(objObject.Class) = "computer" Then
				intUAC = objObject.userAccountControl
				If intUAC And ADS_UF_ACCOUNTDISABLE Then
					lst_disabledcomputers.Add objMember, 0
				Else
					lst_computers.Add objMember, 0
				End If
			ElseIf LCase(objObject.Class) = "group" Then
				lst_groups.Add objMember, 0
				strMail = ""
				On Error Resume Next
				strMail = objObject.mail
				Err.Clear
				On Error GoTo 0
				If strMail <> "" And IsNull(objObject.mail) = False Then
					Set objMember = Document.CreateElement("OPTION")
					objMember.Text = objObject.cn
			        objMember.Value = objObject.distinguishedname
					lst_mailenabledgroups.Add objMember, 0
				End If
				Err.Clear
				On Error GoTo 0
			End If
			If chk_recurse.checked = True Then
				GetOUObjects objObject.adsPath
			End If
		Next
	End Sub
	
	Sub Export_Excel
		Set objExcel = CreateObject("Excel.Application")
		Set objWB = objExcel.Workbooks.Add
		Set objSheet = objWB.Sheets(1)
		objExcel.Visible = True
		objSheet.Cells(1, 1).Value = "Report Date " & Date
		objSheet.Cells(1, 1).Font.Bold = True
 
		Const adVarChar = 200
		Const adBigInt = 20
		Const MaxCharacters = 255	
		Set DataList = CreateObject("ADOR.Recordset")
		DataList.Fields.Append "OU", adVarChar, MaxCharacters
		DataList.Fields.Append "Users", adBigInt
		DataList.Fields.Append "Computers", adBigInt
		DataList.Fields.Append "Groups", adBigInt
		DataList.Fields.Append "MailEnabledUsers", adBigInt
		DataList.Fields.Append "MailEnabledGroups", adBigInt
		DataList.Fields.Append "DisabledUsers", adBigInt
		DataList.Fields.Append "DisabledComputers", adBigInt
		
		DataList.Open
		
		' Users
		For Each objEntry In lst_Users.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Users") = 1
				DataList.Update
			Else
				DataList("Users") = CInt(DataList("Users")) + 1
			End If
		Next
		
		' Computers
		For Each objEntry In lst_Computers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Computers") = 1
				DataList.Update
			Else
				DataList("Computers") = CInt(DataList("Computers")) + 1
			End If
		Next
 
		' Groups
		For Each objEntry In lst_groups.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Groups") = 1
				DataList.Update
			Else
				DataList("Groups") = CInt(DataList("Groups")) + 1
			End If
		Next
 
		' Mail-Enalbed Users
		For Each objEntry In lst_mailenabledusers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("MailEnabledUsers") = 1
				DataList.Update
			Else
				DataList("MailEnabledUsers") = CInt(DataList("MailEnabledUsers")) + 1
			End If
		Next
 
		' Mail-Enalbed Groups
		For Each objEntry In lst_mailenabledgroups.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("MailEnabledGroups") = 1
				DataList.Update
			Else
				DataList("MailEnabledGroups") = CInt(DataList("MailEnabledGroups")) + 1
			End If
		Next
 
		' Disabled Users
		For Each objEntry In lst_disabledusers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("DisabledUsers") = 1
				DataList.Update
			Else
				DataList("DisabledUsers") = CInt(DataList("DisabledUsers")) + 1
			End If
		Next
 
		' Disabled Computers
		For Each objEntry In lst_disabledcomputers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("DisabledComputers") = 1
				DataList.Update
			Else
				DataList("DisabledComputers") = CInt(DataList("DisabledComputers")) + 1
			End If
		Next
 
		' Output
		DataList.filter = ""
		DataList.Sort = "OU"
		If Not DataList.BOF Then DataList.MoveFirst
		' Create a dictionary object of the selected OUs to segment the report with
		Set objOUs = CreateObject("Scripting.Dictionary")
		For Each strSelectedOU In Split(span_sitefilter.InnerHTML, "<BR>")
			arrOU = Split(strSelectedOU, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			objOUs.Add LCase(strOU), 0
		Next
		intRow = 1
		For Each strSelectedOU In objOUs
			intRow = intRow + 2
			objSheet.Cells(intRow, 1).Value = "OU with Sub OU's if they exist"
			objSheet.Cells(intRow, 2).Value = "Users"
			objSheet.Cells(intRow, 3).Value = "Computers"
			objSheet.Cells(intRow, 4).Value = "Groups"
			objSheet.Cells(intRow, 5).Value = "Mail-Enabled Users"
			objSheet.Cells(intRow, 6).Value = "Mail-Enabled Groups"
			objSheet.Cells(intRow, 7).Value = "Disabled Users"
			objSheet.Cells(intRow, 8).Value = "Disabled Computers"
			objSheet.Rows(intRow & ":" & intRow).Font.Bold = True
			objSheet.Rows(intRow & ":" & intRow).Font.ColorIndex = 55
			intRow = intRow + 1
			intStartRow = intRow
			DataList.MoveFirst
			While Not DataList.EOF
				If InStr(LCase(DataList("OU")), LCase(strSelectedOU)) > 0 Then
					For intCol = 2 To 8
						objSheet.Cells(intRow, intCol).Value = 0
					Next
					objSheet.Cells(intRow, 1).Value = DataList("OU")
					If DataList("Users") = "" Then
						objSheet.Cells(intRow, 2).Value = 0
					Else
						objSheet.Cells(intRow, 2).Value = DataList("Users")
					End If
					If DataList("Computers") = "" Then
						objSheet.Cells(intRow, 3).Value = 0
					Else
						objSheet.Cells(intRow, 3).Value = DataList("Computers")
					End If
					If DataList("Groups") = "" Then
						objSheet.Cells(intRow, 4).Value = 0
					Else
						objSheet.Cells(intRow, 4).Value = DataList("Groups")
					End If
					If DataList("MailEnabledUsers") = "" Then
						objSheet.Cells(intRow, 5).Value = 0
					Else
						objSheet.Cells(intRow, 5).Value = DataList("MailEnabledUsers")
					End If
					If DataList("MailEnabledGroups") = "" Then
						objSheet.Cells(intRow, 6).Value = 0
					Else
						objSheet.Cells(intRow, 6).Value = DataList("MailEnabledGroups")
					End If
					If DataList("DisabledUsers") = "" Then
						objSheet.Cells(intRow, 7).Value = 0
					Else
						objSheet.Cells(intRow, 7).Value = DataList("DisabledUsers")
					End If
					If DataList("DisabledComputers") = "" Then
						objSheet.Cells(intRow, 8).Value = 0
					Else
						objSheet.Cells(intRow, 8).Value = DataList("DisabledComputers")
					End If
					intRow = intRow + 1
				End If
				DataList.MoveNext
			Wend
			intRow = intRow + 1
			objSheet.Cells(intRow, 1).Value = "TOTAL:"
			objSheet.Rows(intRow & ":" & intRow).Font.Bold = True
			objSheet.Rows(intRow & ":" & intRow).Font.ColorIndex = 55
			For intCol = 2 To 8
				strFormula = "=SUM(" & Chr((intCol) + 64) & intStartRow & ":" & Chr((intCol) + 64) & intRow - 2 & ")"
				objSheet.Cells(intRow, intCol).Formula = strFormula
			Next
		Next
		objSheet.Columns.AutoFit
	End Sub
 
	Sub Export_HTML
		strHTML = "<html>"
		strHTML = strHTML & VbCrLf & "<body>"
		strHTML = strHTML & VbCrLf & "<table>"
		strHTML = strHTML & VbCrLf & "	<table width='90%' height='90%' border='2' align='center'>"
		strHTML = strHTML & VbCrLf & "		<tr>"
		strHTML = strHTML & VbCrLf & "			<td colspan='8'><b>Report Date: " & Now & "</b></td>"
		strHTML = strHTML & VbCrLf & "		</tr>"
 
		Const adVarChar = 200
		Const adBigInt = 20
		Const MaxCharacters = 255	
		Set DataList = CreateObject("ADOR.Recordset")
		DataList.Fields.Append "OU", adVarChar, MaxCharacters
		DataList.Fields.Append "Users", adBigInt
		DataList.Fields.Append "Computers", adBigInt
		DataList.Fields.Append "Groups", adBigInt
		DataList.Fields.Append "MailEnabledUsers", adBigInt
		DataList.Fields.Append "MailEnabledGroups", adBigInt
		DataList.Fields.Append "DisabledUsers", adBigInt
		DataList.Fields.Append "DisabledComputers", adBigInt
		
		DataList.Open
		
		' Users
		For Each objEntry In lst_Users.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Users") = 1
				DataList.Update
			Else
				DataList("Users") = CInt(DataList("Users")) + 1
			End If
		Next
		
		' Computers
		For Each objEntry In lst_Computers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Computers") = 1
				DataList.Update
			Else
				DataList("Computers") = CInt(DataList("Computers")) + 1
			End If
		Next
 
		' Groups
		For Each objEntry In lst_groups.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Groups") = 1
				DataList.Update
			Else
				DataList("Groups") = CInt(DataList("Groups")) + 1
			End If
		Next
 
		' Mail-Enalbed Users
		For Each objEntry In lst_mailenabledusers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("MailEnabledUsers") = 1
				DataList.Update
			Else
				DataList("MailEnabledUsers") = CInt(DataList("MailEnabledUsers")) + 1
			End If
		Next
 
		' Mail-Enalbed Groups
		For Each objEntry In lst_mailenabledgroups.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("MailEnabledGroups") = 1
				DataList.Update
			Else
				DataList("MailEnabledGroups") = CInt(DataList("MailEnabledGroups")) + 1
			End If
		Next
 
		' Disabled Users
		For Each objEntry In lst_disabledusers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("DisabledUsers") = 1
				DataList.Update
			Else
				DataList("DisabledUsers") = CInt(DataList("DisabledUsers")) + 1
			End If
		Next
 
		' Disabled Computers
		For Each objEntry In lst_disabledcomputers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("DisabledComputers") = 1
				DataList.Update
			Else
				DataList("DisabledComputers") = CInt(DataList("DisabledComputers")) + 1
			End If
		Next
 
		' Output
		DataList.filter = ""
		DataList.Sort = "OU"
		If Not DataList.BOF Then DataList.MoveFirst
		' Create a dictionary object of the selected OUs to segment the report with
		Set objOUs = CreateObject("Scripting.Dictionary")
		For Each strSelectedOU In Split(span_sitefilter.InnerHTML, "<BR>")
			arrOU = Split(strSelectedOU, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			objOUs.Add LCase(strOU), 0
		Next
		For Each strSelectedOU In objOUs
			strHTML = strHTML & VbCrLf & "		<tr>"
			strHTML = strHTML & VbCrLf & "			<td colspan='8'>&nbsp;</td>"
			strHTML = strHTML & VbCrLf & "		</tr>"
			strHTML = strHTML & VbCrLf & "		<tr>"
			strHTML = strHTML & VbCrLf & "			<td><font color='#333399'><b>OU with Sub OU's if they exist</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>Users</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>Computers</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>Groups</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>Mail-Enabled Users</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>Mail-Enabled Groups</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>Disabled Users</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>Disabled Computers</b></font></td>"
			strHTML = strHTML & VbCrLf & "		</tr>"
			strHTML = strHTML & VbCrLf & "		</tr>"
			intUsersTotal = 0
			intComputersTotal = 0
			intGroupsTotal = 0
			intMailEnabledUsersTotal = 0
			intMailEnabledGroupsTotal = 0
			intDisabledUsersTotal = 0
			intDisabledComputersTotal = 0
			DataList.MoveFirst
			While Not DataList.EOF
				If InStr(LCase(DataList("OU")), LCase(strSelectedOU)) > 0 Then
					strHTML = strHTML & VbCrLf & "		<tr>"
					strHTML = strHTML & VbCrLf & "			<td>" & DataList("OU") & "</td>"
					If DataList("Users") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("Users") & "</td>"
						intUsersTotal = intUsersTotal + CInt(DataList("Users"))
					End If
					If DataList("Computers") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("Computers") & "</td>"
						intComputersTotal = intComputersTotal + CInt(DataList("Computers"))
					End If
					If DataList("Groups") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("Groups") & "</td>"
						intGroupsTotal = intGroupsTotal + CInt(DataList("Groups"))
					End If
					If DataList("MailEnabledUsers") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("MailEnabledUsers") & "</td>"
						intMailEnabledUsersTotal = intMailEnabledUsersTotal + CInt(DataList("MailEnabledUsers"))
					End If
					If DataList("MailEnabledGroups") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("MailEnabledGroups") & "</td>"
						intMailEnabledGroupsTotal = intMailEnabledGroupsTotal + CInt(DataList("MailEnabledGroups"))
					End If
					If DataList("DisabledUsers") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("DisabledUsers") & "</td>"
						intDisabledUsersTotal = intDisabledUsersTotal + CInt(DataList("DisabledUsers"))
					End If
					If DataList("DisabledComputers") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("DisabledComputers") & "</td>"
						intDisabledComputersTotal = intDisabledComputersTotal + CInt(DataList("DisabledComputers"))
					End If
					strHTML = strHTML & VbCrLf & "		</tr>"
				End If
				DataList.MoveNext
			Wend
			strHTML = strHTML & VbCrLf & "		<tr><td colspan='8'>&nbsp;</td></tr>"
			strHTML = strHTML & VbCrLf & "		<tr>"
			strHTML = strHTML & VbCrLf & "			<td><font color='#333399'><b>TOTAL:</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intUsersTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intComputersTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intGroupsTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intMailEnabledUsersTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intMailEnabledGroupsTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intDisabledUsersTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intDisabledComputersTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "		</tr>"
		Next
		strHTML = strHTML & VbCrLf & "	</table>"
		strHTML = strHTML & VbCrLf & "</body>"
		strHTML = strHTML & VbCrLf & "</html>"
		Set objFSO = CreateObject("Scripting.FileSystemObject")
		strHTMLFile = "HTML_Report_" & Year(Date) & Right("0" & Month(Date), 2) & Right("0" & Day(Date), 2) & Right("0" & Hour(Time), 2) & Right("0" & Minute(Time), 2) & Right("0" & Second(Time), 2) & ".html"
		Set objHTML = objFSO.CreateTextFile(strHTMLFile, True)
		objHTML.Write strHTML
		objHTML.Close
		Set objShell = CreateObject("WScript.Shell")
		objShell.Run strHTMLFile, 1, False
	End Sub
 
</script>
<body style="background-color:#B0C4DE;" onkeypress='vbs:Default_Buttons'>
	<table height="90%" width= "90%" border="0" align="center">
		<tr>
			<td align="center" colspan="3">
				<h2>List OU Users, Computers, and Groups</h2>
			</td>
		</tr>
		<tr>
			<td>
				<b>Site Filter:</b><br>Select multiple OUs with<br>CTRL + Click
			</td>
			<td colspan="2">
			    <select size='8' name='lst_SiteFilter' onChange='vbs:Show_Selection' multiple="True">
				</select>
			</td>
		</tr>
		<tr>
			<td>
				&nbsp;
			</td>
			<td>
				<input type="checkbox" id="chk_recurse" name="chk_recurse">Recurse Sub OUs
			</td>
			<td>
				<button name="btn_run" id="btn_run" accessKey="G" onclick="vbs:Get_Members"><u>G</u>et Members</button>
			</td>
		</tr>
		<tr>
			<td colspan=3>
				<b>OU Selected:</b>&nbsp&nbsp&nbsp<span id='span_SiteFilter'></span>
			</td>
		</tr>
		<tr>
			<td>
				<b>Users:</b><br>
			    <select size='4' name='lst_users'>
				</select>
				<br><b>Total: </b><span id="span_totalusers"></span>
			</td>
			<td>
				<b>Computers:</b><br>
			    <select size='4' name='lst_computers'>
				</select>
				<br><b>Total: </b><span id="span_totalcomputers"></span>
			</td>
			<td>
				<b>Groups:</b><br>
			    <select size='4' name='lst_groups'>
				</select>
				<br><b>Total: </b><span id="span_totalgroups"></span>
			</td>
		</tr>
		<tr>
			<td>
				<b>Mail-Enabled Users:</b><br>
			    <select size='4' name='lst_mailenabledusers'>
				</select>
				<br><b>Total: </b><span id="span_totalmailusers"></span>
			</td>
			<td>
				&nbsp;
			</td>
			<td>
				<b>Mail-Enabled Groups:</b><br>
			    <select size='4' name='lst_mailenabledgroups'>
				</select>
				<br><b>Total: </b><span id="span_totalmailgroups"></span>
			</td>
		</tr>
		<tr>
			<td>
				<b>Disabled Users:</b><br>
			    <select size='4' name='lst_disabledusers'>
				</select>
				<br><b>Total: </b><span id="span_totaldisabledusers"></span>
			</td>
			<td>
				<b>Disabled Computers:</b><br>
			    <select size='4' name='lst_disabledcomputers'>
				</select>
				<br><b>Total: </b><span id="span_totaldisabledcomputers"></span>
			</td>
			<td>
				&nbsp;
			</td>
		</tr>
	</table>
	<table width= "90%" border="0" align="center">
		<tr align="center">
			<td>
				<button name="btn_exportexcel" id="btn_exportexcel" accessKey="e" onclick="vbs:Export_Excel">Export to <u>E</u>xcel</button>
				&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
				<button name="btn_exporthtml" id="btn_exporthtml" accessKey="h" onclick="vbs:Export_HTML">Export to <u>H</u>TML</button>
			</td>
		</tr>
		<tr align="center">
			<td>
				<button name="btn_exit" id="btn_exit" accessKey="x" onclick="vbs:Exit_HTA">E<u>x</u>it</button>
			</td>
		</tr>
	</table>
</body>
</head>
</html>

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:
557:
558:
559:
560:
561:
562:
563:
564:
565:
566:
567:
568:
569:
570:
571:
572:
573:
574:
575:
576:
577:
578:
579:
580:
581:
582:
583:
584:
585:
586:
587:
588:
589:
590:
591:
592:
593:
594:
595:
596:
597:
598:
599:
600:
601:
602:
603:
604:
605:
606:
607:
608:
609:
610:
611:
612:
613:
614:
615:
616:
617:
618:
619:
620:
621:
622:
623:
624:
625:
626:
627:
628:
629:
630:
631:
632:
633:
634:
635:
636:
637:
638:
639:
640:
641:
642:
643:
644:
645:
646:
647:
648:
649:
650:
651:
652:
653:
654:
655:
656:
657:
658:
659:
660:
661:
662:
663:
664:
665:
666:
667:
668:
669:
670:
671:
672:
673:
674:
675:
676:
677:
678:
679:
680:
681:
682:
683:
684:
685:
686:
687:
688:
689:
690:
691:
692:
693:
694:
695:
696:
697:
698:
699:
700:
701:
702:
703:
704:
705:
706:
707:
708:
709:
710:
711:
712:
713:
714:
715:
716:
717:
718:
719:
720:
721:
722:
723:
724:
725:
726:
727:
728:
729:
730:
731:
732:
733:
734:
735:
736:
737:
738:
739:
740:
741:
742:
743:
744:
745:
746:
747:
748:
749:
750:
751:
752:
753:
754:
755:
756:
757:
758:
759:
760:
761:
762:
763:
764:
765:
766:
767:
768:
769:
770:
771:
772:
773:
774:
775:
776:
777:
778:
779:
780:
781:
782:
783:
784:
785:
786:
787:
788:
789:
790:
791:
792:
793:
794:
795:
796:
797:
798:
799:
800:
801:
802:
803:
804:
805:
806:
807:
808:
809:
810:
811:
812:
813:
814:
815:
816:
817:
818:
819:
820:
821:
822:
823:
824:
825:
826:
827:
828:
829:
830:
831:
832:
833:
834:
835:
836:
837:
838:
839:
840:
841:
842:
843:
844:
845:
846:
847:
848:
849:
850:
851:
852:
853:
854:
855:
856:
857:
858:
859:
860:
861:
862:
863:
864:
865:
866:
867:
868:
869:
870:
871:
872:
873:
874:
875:
876:
877:
878:
879:
880:
881:
882:
883:
884:
885:
886:
887:
888:
889:
890:
891:
892:
893:
894:
895:
896:
897:
898:
899:
900:
901:
902:
903:
904:
905:
906:
907:
908:
909:
910:
911:

Select all Open in new window

by: eperez0968Posted on 2009-11-11 at 14:39:15ID: 25799932

i have picked the wrong Accepted Solution should be the last posting by ROB,,,

11/11/09 04:53 PM, ID: 25799517

i guess i had fat fingers and clicked to fast,,, Sorry

by: RobSampsonPosted on 2009-11-11 at 16:52:26ID: 25800725

Eric,

Thanks for the grade.

I will request the attention of the Mods to select the correct answer.

Rob.

by: eperez0968Posted on 2009-11-11 at 17:18:26ID: 31641078

this person is trully a Genius!!!!! :)

by: techcalvinPosted on 2009-11-18 at 10:34:07ID: 25853192

Hey Rob,

Awesome HTA Script!
Would it be possible to export the Users, Computer, Groups names/list to Excel worksheet2?
The more detail the script can retrieve from AD, the better it is.

Thanks

by: RobSampsonPosted on 2009-11-19 at 17:14:59ID: 25866942

Hi techcalvin, I'm glad you like this HTA. It is pretty handy.

I have added the contents of the list boxes to the export to Excel feature.

Regards,

Rob.

<Html>
<Head>
<Title>List OU Users, Computers, and Groups</Title>
 
<HTA:Application
Caption = Yes
Border = Thick
ShowInTaskBar = Yes
SingleInstance = Yes
MaximizeButton = Yes
MinimizeButton = Yes>
 
<script Language = VBScript>
 
	Sub Window_OnLoad
		intWidth = 800
		intHeight = 800
		Me.ResizeTo intWidth, intHeight
		Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
		lst_users.Style.Width = 200
		lst_computers.Style.Width = 200
		lst_groups.Style.Width = 200
		lst_mailenabledusers.Style.Width = 200
		lst_mailenabledgroups.Style.Width = 200
		lst_disabledusers.Style.Width = 200
		lst_disabledcomputers.Style.Width = 200
    	Set objRootDSE = GetObject("LDAP://RootDSE")
    	strBaseConnString = objRootDSE.Get("defaultNamingContext")
		Set objOULevel = GetObject("LDAP://" & strBaseConnString)
		RecurseOUs objOULevel, 0, strBaseConnString
		Show_Selection
	End Sub
 
	Sub Clear_Users
		For intListProgress = 1 To lst_Users.Length
	   		lst_Users.Remove 0
	   	Next
	   	span_totalusers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_Computers
		For intListProgress = 1 To lst_computers.Length
	   		lst_computers.Remove 0
	   	Next
	   	span_totalcomputers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_Groups
		For intListProgress = 1 To lst_groups.Length
	   		lst_groups.Remove 0
	   	Next
	   	span_totalgroups.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_MailEnabledUsers
		For intListProgress = 1 To lst_mailenabledusers.Length
	   		lst_mailenabledusers.Remove 0
	   	Next
	   	span_totalmailusers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_MailEnabledGroups
		For intListProgress = 1 To lst_mailenabledgroups.Length
	   		lst_mailenabledgroups.Remove 0
	   	Next
	   	span_totalmailgroups.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_DisabledUsers
		For intListProgress = 1 To lst_disabledusers.Length
	   		lst_disabledusers.Remove 0
	   	Next
	   	span_totaldisabledusers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub Clear_DisabledComputers
		For intListProgress = 1 To lst_disabledcomputers.Length
	   		lst_disabledcomputers.Remove 0
	   	Next
	   	span_totaldisabledcomputers.InnerHTML = "<b>0</b>"
	End Sub
 
	Sub RecurseOUs(objOU, intLevel, strBaseConn)
		Dim objOUObject, strConnString, objActiveOption
		For Each objOUObject In objOU
			If UCase(Left(objOUObject.Name, 3)) = "OU=" Then
				strConnString = objOUObject.DistinguishedName
				Set objActiveOption = Document.CreateElement("OPTION")
		    	If intLevel = 0 Then
		    		objActiveOption.Text = Replace(objOUObject.Name, "OU=", "")
		    	Else
		    		objActiveOption.Text = String(intLevel * 4, " ") & "->   " & Replace(objOUObject.Name, "OU=", "")
		    	End If
		    	objActiveOption.Value = strConnString
		    	lst_SiteFilter.Add objActiveOption
				On Error Resume Next
				RecurseOUs GetObject("LDAP://" & strConnString), intLevel + 1, strBaseConn
				If Err.Number <> 0 Then
					MsgBox "Error enumerating " & strConnString
				End If
				Err.Clear
				On Error GoTo 0
			End If
		Next
	End Sub
 
	Sub Show_Selection
		span_SiteFilter.InnerHTML = ""
		For Each objOption In lst_SiteFilter.Options
			If objOption.Selected = True Then
				If span_SiteFilter.InnerHTML = "" Then
					span_SiteFilter.InnerHTML = objOption.Value
				Else
					span_SiteFilter.InnerHTML = span_SiteFilter.InnerHTML & "<BR>" & objOption.Value
				End If
			End If
		Next
	End Sub
 
	Sub Default_Buttons
		If Window.Event.KeyCode = 13 Then
			btn_run.Click
		End If
	End Sub
 
	Sub Exit_HTA
		Window.Close
	End Sub
 
	Sub Get_Members
		Clear_Users
		Clear_Computers
		Clear_Groups
		Clear_MailEnabledUsers
		Clear_MailEnabledGroups
		Clear_DisabledUsers
		Clear_DisabledComputers
		
		Set objConnection2 = CreateObject("ADODB.Connection")
		Set objCommand2 = CreateObject("ADODB.Command")
		objConnection2.Provider = "ADsDSOObject"
		objConnection2.Open "Active Directory Provider"
		Set objCommand2.ActiveConnection = objConnection2
		
		For Each strOU In Split(span_sitefilter.InnerHTML, "<BR>")
			GetOUObjects("LDAP://" & strOU)
		Next
		
		span_totalusers.InnerHTML = "<b>" & lst_users.Length & "</b>"
		span_totalcomputers.InnerHTML = "<b>" & lst_computers.Length & "</b>"
		span_totalgroups.InnerHTML = "<b>" & lst_groups.Length & "</b>"
		span_totalmailusers.InnerHTML = "<b>" & lst_mailenabledusers.Length & "</b>"
		span_totalmailgroups.InnerHTML = "<b>" & lst_mailenabledgroups.Length & "</b>"
		span_totaldisabledusers.InnerHTML = "<b>" & lst_disabledusers.Length & "</b>"
		span_totaldisabledcomputers.InnerHTML = "<b>" & lst_disabledcomputers.Length & "</b>"
	End Sub
	
	Sub GetOUObjects(strLDAPPath)
		Const ADS_UF_ACCOUNTDISABLE = 2
		Set objOU = GetObject(strLDAPPath)
		For Each objObject In objOU
			Set objMember = Document.CreateElement("OPTION")
			objMember.Text = objObject.cn
	        objMember.Value = objObject.distinguishedname
			If LCase(objObject.Class) = "user" Then
				intUAC = objObject.userAccountControl
				If intUAC And ADS_UF_ACCOUNTDISABLE Then
					lst_disabledusers.Add objMember, 0
				Else
					lst_users.Add objMember, 0
				End If
				strMail = ""
				On Error Resume Next
				strMail = objObject.mail
				Err.Clear
				On Error GoTo 0
				If strMail <> "" And IsNull(objObject.mail) = False Then
					Set objMember = Document.CreateElement("OPTION")
					objMember.Text = objObject.cn
			        objMember.Value = objObject.distinguishedname
					lst_mailenabledusers.Add objMember, 0
				End If
				Err.Clear
				On Error GoTo 0
			ElseIf LCase(objObject.Class) = "computer" Then
				intUAC = objObject.userAccountControl
				If intUAC And ADS_UF_ACCOUNTDISABLE Then
					lst_disabledcomputers.Add objMember, 0
				Else
					lst_computers.Add objMember, 0
				End If
			ElseIf LCase(objObject.Class) = "group" Then
				lst_groups.Add objMember, 0
				strMail = ""
				On Error Resume Next
				strMail = objObject.mail
				Err.Clear
				On Error GoTo 0
				If strMail <> "" And IsNull(objObject.mail) = False Then
					Set objMember = Document.CreateElement("OPTION")
					objMember.Text = objObject.cn
			        objMember.Value = objObject.distinguishedname
					lst_mailenabledgroups.Add objMember, 0
				End If
				Err.Clear
				On Error GoTo 0
			End If
			If chk_recurse.checked = True Then
				GetOUObjects objObject.adsPath
			End If
		Next
	End Sub
	
	Sub Export_Excel
		Set objExcel = CreateObject("Excel.Application")
		Set objWB = objExcel.Workbooks.Add
		Set objSheet = objWB.Sheets(1)
		objExcel.Visible = True
		objSheet.Cells(1, 1).Value = "Report Date " & Date
		objSheet.Cells(1, 1).Font.Bold = True
 
		Const adVarChar = 200
		Const adBigInt = 20
		Const MaxCharacters = 255	
		Set DataList = CreateObject("ADOR.Recordset")
		DataList.Fields.Append "OU", adVarChar, MaxCharacters
		DataList.Fields.Append "Users", adBigInt
		DataList.Fields.Append "Computers", adBigInt
		DataList.Fields.Append "Groups", adBigInt
		DataList.Fields.Append "MailEnabledUsers", adBigInt
		DataList.Fields.Append "MailEnabledGroups", adBigInt
		DataList.Fields.Append "DisabledUsers", adBigInt
		DataList.Fields.Append "DisabledComputers", adBigInt
		
		DataList.Open
		
		' Users
		For Each objEntry In lst_Users.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Users") = 1
				DataList.Update
			Else
				DataList("Users") = CInt(DataList("Users")) + 1
			End If
		Next
		
		' Computers
		For Each objEntry In lst_Computers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Computers") = 1
				DataList.Update
			Else
				DataList("Computers") = CInt(DataList("Computers")) + 1
			End If
		Next
 
		' Groups
		For Each objEntry In lst_groups.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Groups") = 1
				DataList.Update
			Else
				DataList("Groups") = CInt(DataList("Groups")) + 1
			End If
		Next
 
		' Mail-Enalbed Users
		For Each objEntry In lst_mailenabledusers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("MailEnabledUsers") = 1
				DataList.Update
			Else
				DataList("MailEnabledUsers") = CInt(DataList("MailEnabledUsers")) + 1
			End If
		Next
 
		' Mail-Enalbed Groups
		For Each objEntry In lst_mailenabledgroups.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("MailEnabledGroups") = 1
				DataList.Update
			Else
				DataList("MailEnabledGroups") = CInt(DataList("MailEnabledGroups")) + 1
			End If
		Next
 
		' Disabled Users
		For Each objEntry In lst_disabledusers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("DisabledUsers") = 1
				DataList.Update
			Else
				DataList("DisabledUsers") = CInt(DataList("DisabledUsers")) + 1
			End If
		Next
 
		' Disabled Computers
		For Each objEntry In lst_disabledcomputers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("DisabledComputers") = 1
				DataList.Update
			Else
				DataList("DisabledComputers") = CInt(DataList("DisabledComputers")) + 1
			End If
		Next
 
		' Output
		DataList.filter = ""
		DataList.Sort = "OU"
		If Not DataList.BOF Then DataList.MoveFirst
		' Create a dictionary object of the selected OUs to segment the report with
		Set objOUs = CreateObject("Scripting.Dictionary")
		For Each strSelectedOU In Split(span_sitefilter.InnerHTML, "<BR>")
			arrOU = Split(strSelectedOU, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			objOUs.Add LCase(strOU), 0
		Next
		intRow = 1
		For Each strSelectedOU In objOUs
			intRow = intRow + 2
			objSheet.Cells(intRow, 1).Value = "OU with Sub OU's if they exist"
			objSheet.Cells(intRow, 2).Value = "Users"
			objSheet.Cells(intRow, 3).Value = "Computers"
			objSheet.Cells(intRow, 4).Value = "Groups"
			objSheet.Cells(intRow, 5).Value = "Mail-Enabled Users"
			objSheet.Cells(intRow, 6).Value = "Mail-Enabled Groups"
			objSheet.Cells(intRow, 7).Value = "Disabled Users"
			objSheet.Cells(intRow, 8).Value = "Disabled Computers"
			objSheet.Rows(intRow & ":" & intRow).Font.Bold = True
			objSheet.Rows(intRow & ":" & intRow).Font.ColorIndex = 55
			intRow = intRow + 1
			intStartRow = intRow
			DataList.MoveFirst
			While Not DataList.EOF
				If InStr(LCase(DataList("OU")), LCase(strSelectedOU)) > 0 Then
					For intCol = 2 To 8
						objSheet.Cells(intRow, intCol).Value = 0
					Next
					objSheet.Cells(intRow, 1).Value = DataList("OU")
					If DataList("Users") = "" Then
						objSheet.Cells(intRow, 2).Value = 0
					Else
						objSheet.Cells(intRow, 2).Value = DataList("Users")
					End If
					If DataList("Computers") = "" Then
						objSheet.Cells(intRow, 3).Value = 0
					Else
						objSheet.Cells(intRow, 3).Value = DataList("Computers")
					End If
					If DataList("Groups") = "" Then
						objSheet.Cells(intRow, 4).Value = 0
					Else
						objSheet.Cells(intRow, 4).Value = DataList("Groups")
					End If
					If DataList("MailEnabledUsers") = "" Then
						objSheet.Cells(intRow, 5).Value = 0
					Else
						objSheet.Cells(intRow, 5).Value = DataList("MailEnabledUsers")
					End If
					If DataList("MailEnabledGroups") = "" Then
						objSheet.Cells(intRow, 6).Value = 0
					Else
						objSheet.Cells(intRow, 6).Value = DataList("MailEnabledGroups")
					End If
					If DataList("DisabledUsers") = "" Then
						objSheet.Cells(intRow, 7).Value = 0
					Else
						objSheet.Cells(intRow, 7).Value = DataList("DisabledUsers")
					End If
					If DataList("DisabledComputers") = "" Then
						objSheet.Cells(intRow, 8).Value = 0
					Else
						objSheet.Cells(intRow, 8).Value = DataList("DisabledComputers")
					End If
					intRow = intRow + 1
				End If
				DataList.MoveNext
			Wend
			intRow = intRow + 1
			objSheet.Cells(intRow, 1).Value = "TOTAL:"
			objSheet.Rows(intRow & ":" & intRow).Font.Bold = True
			objSheet.Rows(intRow & ":" & intRow).Font.ColorIndex = 55
			For intCol = 2 To 8
				strFormula = "=SUM(" & Chr((intCol) + 64) & intStartRow & ":" & Chr((intCol) + 64) & intRow - 2 & ")"
				objSheet.Cells(intRow, intCol).Formula = strFormula
			Next
		Next
		objSheet.Columns.AutoFit
		
		' Now list the contents of the boxes in the second sheet
		Set objSheet = objWB.Sheets(2)
		objExcel.Visible = True
		objSheet.Cells(1, 1).Value = "Report Date " & Date
		objSheet.Cells(1, 1).Font.Bold = True
		
		' Users
		intRow = 3
		objSheet.Cells(intRow, 1).Value = "Users"
		objSheet.Cells(intRow, 1).Font.Bold = True
		objSheet.Cells(intRow, 1).Font.ColorIndex = 55
		intRow = intRow + 1
		objSheet.Cells(intRow, 1).Value = "OU Path"
		objSheet.Cells(intRow, 2).Value = "Display Name"
		objSheet.Rows(intRow & ":" & intRow).Font.Bold = True
		objSheet.Rows(intRow & ":" & intRow).Font.ColorIndex = 55
		intRow = intRow + 1
		For Each objEntry In lst_Users.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			objSheet.Cells(intRow, 1) = strOU
			objSheet.Cells(intRow, 2) = objEntry.Text
			intRow = intRow + 1
		Next
 
		' Computers
		intRow = intRow + 1
		objSheet.Cells(intRow, 1).Value = "Computers"
		objSheet.Cells(intRow, 1).Font.Bold = True
		objSheet.Cells(intRow, 1).Font.ColorIndex = 55
		intRow = intRow + 1
		objSheet.Cells(intRow, 1).Value = "OU Path"
		objSheet.Cells(intRow, 2).Value = "Display Name"
		objSheet.Rows(intRow & ":" & intRow).Font.Bold = True
		objSheet.Rows(intRow & ":" & intRow).Font.ColorIndex = 55
		intRow = intRow + 1
		For Each objEntry In lst_Computers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			objSheet.Cells(intRow, 1) = strOU
			objSheet.Cells(intRow, 2) = objEntry.Text
			intRow = intRow + 1
		Next
 
		' Groups
		intRow = intRow + 1
		objSheet.Cells(intRow, 1).Value = "Groups"
		objSheet.Cells(intRow, 1).Font.Bold = True
		objSheet.Cells(intRow, 1).Font.ColorIndex = 55
		intRow = intRow + 1
		objSheet.Cells(intRow, 1).Value = "OU Path"
		objSheet.Cells(intRow, 2).Value = "Display Name"
		objSheet.Rows(intRow & ":" & intRow).Font.Bold = True
		objSheet.Rows(intRow & ":" & intRow).Font.ColorIndex = 55
		intRow = intRow + 1
 
		For Each objEntry In lst_Groups.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			objSheet.Cells(intRow, 1) = strOU
			objSheet.Cells(intRow, 2) = objEntry.Text
			intRow = intRow + 1
		Next
 
		' Mail-Enabled Users
		intRow = intRow + 1
		objSheet.Cells(intRow, 1).Value = "Mail-Enabled Users"
		objSheet.Cells(intRow, 1).Font.Bold = True
		objSheet.Cells(intRow, 1).Font.ColorIndex = 55
		intRow = intRow + 1
		objSheet.Cells(intRow, 1).Value = "OU Path"
		objSheet.Cells(intRow, 2).Value = "Display Name"
		objSheet.Rows(intRow & ":" & intRow).Font.Bold = True
		objSheet.Rows(intRow & ":" & intRow).Font.ColorIndex = 55
		intRow = intRow + 1
		For Each objEntry In lst_MailEnabledUsers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			objSheet.Cells(intRow, 1) = strOU
			objSheet.Cells(intRow, 2) = objEntry.Text
			intRow = intRow + 1
		Next
 
		' Mail-Enabled Groups
		intRow = intRow + 1
		objSheet.Cells(intRow, 1).Value = "Mail-Enabled Groups"
		objSheet.Cells(intRow, 1).Font.Bold = True
		objSheet.Cells(intRow, 1).Font.ColorIndex = 55
		intRow = intRow + 1
		objSheet.Cells(intRow, 1).Value = "OU Path"
		objSheet.Cells(intRow, 2).Value = "Display Name"
		objSheet.Rows(intRow & ":" & intRow).Font.Bold = True
		objSheet.Rows(intRow & ":" & intRow).Font.ColorIndex = 55
		intRow = intRow + 1
		For Each objEntry In lst_MailEnabledGroups.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			objSheet.Cells(intRow, 1) = strOU
			objSheet.Cells(intRow, 2) = objEntry.Text
			intRow = intRow + 1
		Next
 
		' Disabled Users
		intRow = intRow + 1
		objSheet.Cells(intRow, 1).Value = "Disabled Users"
		objSheet.Cells(intRow, 1).Font.Bold = True
		objSheet.Cells(intRow, 1).Font.ColorIndex = 55
		intRow = intRow + 1
		objSheet.Cells(intRow, 1).Value = "OU Path"
		objSheet.Cells(intRow, 2).Value = "Display Name"
		objSheet.Rows(intRow & ":" & intRow).Font.Bold = True
		objSheet.Rows(intRow & ":" & intRow).Font.ColorIndex = 55
		intRow = intRow + 1
		For Each objEntry In lst_DisabledUsers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			objSheet.Cells(intRow, 1) = strOU
			objSheet.Cells(intRow, 2) = objEntry.Text
			intRow = intRow + 1
		Next
 
		' Disabled Computers
		intRow = intRow + 1
		objSheet.Cells(intRow, 1).Value = "Disabled Computers"
		objSheet.Cells(intRow, 1).Font.Bold = True
		objSheet.Cells(intRow, 1).Font.ColorIndex = 55
		intRow = intRow + 1
		objSheet.Cells(intRow, 1).Value = "OU Path"
		objSheet.Cells(intRow, 2).Value = "Display Name"
		objSheet.Rows(intRow & ":" & intRow).Font.Bold = True
		objSheet.Rows(intRow & ":" & intRow).Font.ColorIndex = 55
		intRow = intRow + 1
		intRow = intRow + 2
		For Each objEntry In lst_DisabledComputers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			objSheet.Cells(intRow, 1) = strOU
			objSheet.Cells(intRow, 2) = objEntry.Text
			intRow = intRow + 1
		Next
 
		objSheet.Columns.AutoFit
	End Sub
 
	Sub Export_HTML
		strHTML = "<html>"
		strHTML = strHTML & VbCrLf & "<body>"
		strHTML = strHTML & VbCrLf & "<table>"
		strHTML = strHTML & VbCrLf & "	<table width='90%' height='90%' border='2' align='center'>"
		strHTML = strHTML & VbCrLf & "		<tr>"
		strHTML = strHTML & VbCrLf & "			<td colspan='8'><b>Report Date: " & Now & "</b></td>"
		strHTML = strHTML & VbCrLf & "		</tr>"
 
		Const adVarChar = 200
		Const adBigInt = 20
		Const MaxCharacters = 255	
		Set DataList = CreateObject("ADOR.Recordset")
		DataList.Fields.Append "OU", adVarChar, MaxCharacters
		DataList.Fields.Append "Users", adBigInt
		DataList.Fields.Append "Computers", adBigInt
		DataList.Fields.Append "Groups", adBigInt
		DataList.Fields.Append "MailEnabledUsers", adBigInt
		DataList.Fields.Append "MailEnabledGroups", adBigInt
		DataList.Fields.Append "DisabledUsers", adBigInt
		DataList.Fields.Append "DisabledComputers", adBigInt
		
		DataList.Open
		
		' Users
		For Each objEntry In lst_Users.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Users") = 1
				DataList.Update
			Else
				DataList("Users") = CInt(DataList("Users")) + 1
			End If
		Next
		
		' Computers
		For Each objEntry In lst_Computers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Computers") = 1
				DataList.Update
			Else
				DataList("Computers") = CInt(DataList("Computers")) + 1
			End If
		Next
 
		' Groups
		For Each objEntry In lst_groups.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("Groups") = 1
				DataList.Update
			Else
				DataList("Groups") = CInt(DataList("Groups")) + 1
			End If
		Next
 
		' Mail-Enalbed Users
		For Each objEntry In lst_mailenabledusers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("MailEnabledUsers") = 1
				DataList.Update
			Else
				DataList("MailEnabledUsers") = CInt(DataList("MailEnabledUsers")) + 1
			End If
		Next
 
		' Mail-Enalbed Groups
		For Each objEntry In lst_mailenabledgroups.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("MailEnabledGroups") = 1
				DataList.Update
			Else
				DataList("MailEnabledGroups") = CInt(DataList("MailEnabledGroups")) + 1
			End If
		Next
 
		' Disabled Users
		For Each objEntry In lst_disabledusers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("DisabledUsers") = 1
				DataList.Update
			Else
				DataList("DisabledUsers") = CInt(DataList("DisabledUsers")) + 1
			End If
		Next
 
		' Disabled Computers
		For Each objEntry In lst_disabledcomputers.Options
			arrOU = Split(objEntry.Value, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			DataList.filter = "OU='" & strOU & "'"
			If DataList.EOF = True Then
				DataList.AddNew
				DataList("OU") = strOU
				DataList("DisabledComputers") = 1
				DataList.Update
			Else
				DataList("DisabledComputers") = CInt(DataList("DisabledComputers")) + 1
			End If
		Next
 
		' Output
		DataList.filter = ""
		DataList.Sort = "OU"
		If Not DataList.BOF Then DataList.MoveFirst
		' Create a dictionary object of the selected OUs to segment the report with
		Set objOUs = CreateObject("Scripting.Dictionary")
		For Each strSelectedOU In Split(span_sitefilter.InnerHTML, "<BR>")
			arrOU = Split(strSelectedOU, ",")
			strOU = ""
			For Each strBit In arrOU
				If Left(UCase(strBit), 3) = "OU=" Then
					If strOU = "" Then
						strOU = Mid(strBit, 4)
					Else
						strOU = Mid(strBit, 4) & "\" & strOU
					End If
				End If
			Next
			objOUs.Add LCase(strOU), 0
		Next
		For Each strSelectedOU In objOUs
			strHTML = strHTML & VbCrLf & "		<tr>"
			strHTML = strHTML & VbCrLf & "			<td colspan='8'>&nbsp;</td>"
			strHTML = strHTML & VbCrLf & "		</tr>"
			strHTML = strHTML & VbCrLf & "		<tr>"
			strHTML = strHTML & VbCrLf & "			<td><font color='#333399'><b>OU with Sub OU's if they exist</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>Users</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>Computers</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>Groups</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>Mail-Enabled Users</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>Mail-Enabled Groups</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>Disabled Users</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>Disabled Computers</b></font></td>"
			strHTML = strHTML & VbCrLf & "		</tr>"
			strHTML = strHTML & VbCrLf & "		</tr>"
			intUsersTotal = 0
			intComputersTotal = 0
			intGroupsTotal = 0
			intMailEnabledUsersTotal = 0
			intMailEnabledGroupsTotal = 0
			intDisabledUsersTotal = 0
			intDisabledComputersTotal = 0
			DataList.MoveFirst
			While Not DataList.EOF
				If InStr(LCase(DataList("OU")), LCase(strSelectedOU)) > 0 Then
					strHTML = strHTML & VbCrLf & "		<tr>"
					strHTML = strHTML & VbCrLf & "			<td>" & DataList("OU") & "</td>"
					If DataList("Users") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("Users") & "</td>"
						intUsersTotal = intUsersTotal + CInt(DataList("Users"))
					End If
					If DataList("Computers") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("Computers") & "</td>"
						intComputersTotal = intComputersTotal + CInt(DataList("Computers"))
					End If
					If DataList("Groups") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("Groups") & "</td>"
						intGroupsTotal = intGroupsTotal + CInt(DataList("Groups"))
					End If
					If DataList("MailEnabledUsers") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("MailEnabledUsers") & "</td>"
						intMailEnabledUsersTotal = intMailEnabledUsersTotal + CInt(DataList("MailEnabledUsers"))
					End If
					If DataList("MailEnabledGroups") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("MailEnabledGroups") & "</td>"
						intMailEnabledGroupsTotal = intMailEnabledGroupsTotal + CInt(DataList("MailEnabledGroups"))
					End If
					If DataList("DisabledUsers") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("DisabledUsers") & "</td>"
						intDisabledUsersTotal = intDisabledUsersTotal + CInt(DataList("DisabledUsers"))
					End If
					If DataList("DisabledComputers") = "" Then
						strHTML = strHTML & VbCrLf & "			<td align='center'>0</td>"
					Else
						strHTML = strHTML & VbCrLf & "			<td align='center'>" & DataList("DisabledComputers") & "</td>"
						intDisabledComputersTotal = intDisabledComputersTotal + CInt(DataList("DisabledComputers"))
					End If
					strHTML = strHTML & VbCrLf & "		</tr>"
				End If
				DataList.MoveNext
			Wend
			strHTML = strHTML & VbCrLf & "		<tr><td colspan='8'>&nbsp;</td></tr>"
			strHTML = strHTML & VbCrLf & "		<tr>"
			strHTML = strHTML & VbCrLf & "			<td><font color='#333399'><b>TOTAL:</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intUsersTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intComputersTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intGroupsTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intMailEnabledUsersTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intMailEnabledGroupsTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intDisabledUsersTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "			<td align='center'><font color='#333399'><b>" & intDisabledComputersTotal & "</b></font></td>"
			strHTML = strHTML & VbCrLf & "		</tr>"
		Next
		strHTML = strHTML & VbCrLf & "	</table>"
		strHTML = strHTML & VbCrLf & "</body>"
		strHTML = strHTML & VbCrLf & "</html>"
		Set objFSO = CreateObject("Scripting.FileSystemObject")
		strHTMLFile = "HTML_Report_" & Year(Date) & Right("0" & Month(Date), 2) & Right("0" & Day(Date), 2) & Right("0" & Hour(Time), 2) & Right("0" & Minute(Time), 2) & Right("0" & Second(Time), 2) & ".html"
		Set objHTML = objFSO.CreateTextFile(strHTMLFile, True)
		objHTML.Write strHTML
		objHTML.Close
		Set objShell = CreateObject("WScript.Shell")
		objShell.Run strHTMLFile, 1, False
	End Sub
 
</script>
<body style="background-color:#B0C4DE;" onkeypress='vbs:Default_Buttons'>
	<table height="90%" width= "90%" border="0" align="center">
		<tr>
			<td align="center" colspan="3">
				<h2>List OU Users, Computers, and Groups</h2>
			</td>
		</tr>
		<tr>
			<td>
				<b>Site Filter:</b><br>Select multiple OUs with<br>CTRL + Click
			</td>
			<td colspan="2">
			    <select size='8' name='lst_SiteFilter' onChange='vbs:Show_Selection' multiple="True">
				</select>
			</td>
		</tr>
		<tr>
			<td>
				&nbsp;
			</td>
			<td>
				<input type="checkbox" id="chk_recurse" name="chk_recurse">Recurse Sub OUs
			</td>
			<td>
				<button name="btn_run" id="btn_run" accessKey="G" onclick="vbs:Get_Members"><u>G</u>et Members</button>
			</td>
		</tr>
		<tr>
			<td colspan=3>
				<b>OU Selected:</b>&nbsp&nbsp&nbsp<span id='span_SiteFilter'></span>
			</td>
		</tr>
		<tr>
			<td>
				<b>Users:</b><br>
			    <select size='4' name='lst_users'>
				</select>
				<br><b>Total: </b><span id="span_totalusers"></span>
			</td>
			<td>
				<b>Computers:</b><br>
			    <select size='4' name='lst_computers'>
				</select>
				<br><b>Total: </b><span id="span_totalcomputers"></span>
			</td>
			<td>
				<b>Groups:</b><br>
			    <select size='4' name='lst_groups'>
				</select>
				<br><b>Total: </b><span id="span_totalgroups"></span>
			</td>
		</tr>
		<tr>
			<td>
				<b>Mail-Enabled Users:</b><br>
			    <select size='4' name='lst_mailenabledusers'>
				</select>
				<br><b>Total: </b><span id="span_totalmailusers"></span>
			</td>
			<td>
				&nbsp;
			</td>
			<td>
				<b>Mail-Enabled Groups:</b><br>
			    <select size='4' name='lst_mailenabledgroups'>
				</select>
				<br><b>Total: </b><span id="span_totalmailgroups"></span>
			</td>
		</tr>
		<tr>
			<td>
				<b>Disabled Users:</b><br>
			    <select size='4' name='lst_disabledusers'>
				</select>
				<br><b>Total: </b><span id="span_totaldisabledusers"></span>
			</td>
			<td>
				<b>Disabled Computers:</b><br>
			    <select size='4' name='lst_disabledcomputers'>
				</select>
				<br><b>Total: </b><span id="span_totaldisabledcomputers"></span>
			</td>
			<td>
				&nbsp;
			</td>
		</tr>
	</table>
	<table width= "90%" border="0" align="center">
		<tr align="center">
			<td>
				<button name="btn_exportexcel" id="btn_exportexcel" accessKey="e" onclick="vbs:Export_Excel">Export to <u>E</u>xcel</button>
				&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
				<button name="btn_exporthtml" id="btn_exporthtml" accessKey="h" onclick="vbs:Export_HTML">Export to <u>H</u>TML</button>
			</td>
		</tr>
		<tr align="center">
			<td>
				<button name="btn_exit" id="btn_exit" accessKey="x" onclick="vbs:Exit_HTA">E<u>x</u>it</button>
			</td>
		</tr>
	</table>
</body>
</head>
</html>

Select all Open in new window

by: eperez0968Posted on 2009-11-27 at 04:29:21ID: 25920421

Hey Rob,
Wondering if you have time to look at this, it is a addon to this script that you have done for me. I have created a new issue

http://www.experts-exchange.com/OS/Microsoft_Operating_Systems/Server/Q_24933152.html

20120131-EE-VQP-002

3 Ways to Join

30-Day Free Trial

For individual users
Instant access to solutions
Ask your tech questions
Start your 30-day Free Trial

Business Accounts

Perfect for organizations
Multiple users
Save over 36%
Create a Business Account

Answer for Membership

Earn free access
Showcase your knowledge
No credit card required
Sign Up to Answer

The Experts

98% positive feedback on 31,087 answers since March 2000. angeliii is a Microsoft Most Valuable Professional for his work with MS SQL Server & Develoment.

He has also proven his knowledge of Visual Basic Programming, PHP Scripting and Oracle Databases.

The Experts

97% positive feedback on 10,752 answers since July 2000. lrmoore has more than 18 years experience in the networking industry.

The six-time Mircosoft MVPs specialties include firewalls, virtual private networking, and network management.

Testimonials

"...and excellent source for support... Kind of like having your very own IT dept." Electriciansnet

Testimonials

"I was apprehensive at signing up at first. However... it has already made my life as an IT administrator much easier." JaCrews

Testimonials

"WOW! You guys have great, active, and knowledgeable people on here." moore50

Business Clients

In the Press

"If you’ve got a question... Experts Exchange can supply an answer.”

In the Press

"...an invaluable aid for both IT professionals and those who require tech support."

In the Press

"where IT professionals provide quick answers on just about any topic"

Business Account Plans

Loading Advertisement...

Question

need a report on how to retrieve OU Structucture and select which OU

Subscribe now for full access to Experts Exchange and get

Instant Access to this Solution

Trusted by hundreds of thousands everyday for fast, accurate and reliable tech support.

See what Experts Exchange can do for you.

Got a question?

We've got the answer.

Need individual assistance?

Our experts are ready to help.

Want to learn from the best?

Read articles from industry experts.

Working on a long term project?

Store your work and research.

What Makes Experts Exchange Unique?

Trusted by the world's most respected brands.

Faithfully serving IT professionals since 1996.

Related Solutions

Free Tech Articles

Cloud Class Webinars

Join the Community

Give a Little. Get a Lot.

Answers

3 Ways to Join

The Experts

The Experts

Testimonials

Testimonials

Testimonials

Business Clients

Business Clients

In the Press

In the Press

In the Press