'OUEnum.vbs
'Alan dot Kaplan at va dot gov
'9/30/2000

Option Explicit

dim wshShell, fso
Dim strList
Set wshShell = WScript.CreateObject("WScript.Shell")
dim quote
quote=chr(34)
Dim strReportFolder,strDomain
Dim iLevel
iLevel = 0
Dim message

'Make sure running Cscript.
If (Not IsCScript()) Then 		'If not CScript, re-run with cscript...
	WshShell.Run "CScript.exe " & quote & WScript.ScriptFullName & quote, 1, True
    WScript.Quit            	'...and stop running as WScript
End If

'Setup Log 
Dim writetype
writetype = 2 ' forwriting

set fso = CreateObject("Scripting.FileSystemObject")

Dim logpath, logtime, logfile, appendout
logpath= wshShell.SpecialFolders("Desktop") & "\"

Dim root, sdomain
Const ADS_SCOPE_OneLevel = 1
Const ADS_CHASE_REFERRALS_ALWAYS = &H20
'Get the ADsPath for the domain to search. 
Set root = GetObject("GC://rootDSE")
sDomain = root.Get("defaultNamingContext")


If wscript.arguments.count = 1 Then
	sdomain = WScript.Arguments(0)
Else
	message ="This script will enumerate the OUs of a domain. " & VbCrLf & VbCrLf & _
	"List OUs for what domain?"
	sdomain = InputBox(message,"Domain",sdomain)
	If sdomain = "" Then WScript.Quit
End If 

strDomain = Replace(sdomain,",","_") & "_"
StrDomain = Replace(sDomain,"DC=","")

Dim oConn, oCommand, oRS
Set oConn = CreateObject("ADODB.Connection")
Set oCommand =   CreateObject("ADODB.Command")
oConn.Provider = "ADsDSOObject"
oConn.Open "Active Directory Provider"
Set oCommand.ActiveConnection = oConn

oCommand.Properties("Page Size") = 100
oCommand.Properties("timeout") = 100
	
'switched to GC syntaxt as easieste way to handle OUs with single quotes 
oCommand.CommandText = "<GC://" & sdomain & ">;(objectCategory=organizationalUnit);Name,ADsPath;onelevel"

Set oRS = oCommand.Execute

logfile = fso.BuildPath(logpath,replace(sdomain,",","_") & "_OUList.xls")
If fso.FileExists(logfile) Then fso.DeleteFile logfile 

Set appendout = fso.OpenTextFile(logfile, writetype, True)
appendout.WriteLine	"OU Name	ADSPath"

oRS.MoveFirst
Do Until oRS.EOF
    GetSubs oRS.Fields("name").Value, oRS.Fields("adsPath").Value,False
    oRS.MoveNext
Loop

On Error Resume Next 
appendout.Close

SaveAsExcel logfile
If wscript.arguments.count = 0 Then wshShell.Run quote & logfile & quote,1,True

' ========= Functions and Subs =======
Function GetSubs(strName, strPath,bRecurse)
	'strPath = ADSPathEscape(strPath)

	Dim objRS
	If Not bRecurse Then 
		iLevel=0
	Else
		iLevel = iLevel + 1
	End If 

    oCommand.CommandText = "<" & strPath& ">;(objectCategory=organizationalUnit);Name,ADsPath;onelevel"

	Set objRS = oCommand.Execute

    Dim i, strArrow
    For i = 1 To iLevel 
    	strArrow = "--> " & strArrow
    Next
	
	If bRecurse Then strName = strArrow & strName
	
	If objRS.Recordcount > 0 Then
		echoandlog  strName & vbTab &  strPath 
		objRS.MoveFirst
		Do Until objRS.EOF
			 GetSubs objRS.Fields("name").Value, objRS.Fields("adsPath").Value,True
	    objRS.MoveNext
		Loop
	Else
		echoandlog  strName & vbTab &  strPath
	End If 
	
	If bRecurse Then		iLevel = iLevel - 1
	
End Function 

	
Sub SaveAsExcel(strFileName)
	Const xlnormal = -4143 
	Dim fso, oXL, objRange
	Set fso = CreateObject("Scripting.FileSystemObject")
	If Not fso.FileExists(strFileName) Then WScript.Quit
	On Error Resume next
	Set oXL = CreateObject("Excel.Application")
	
	If Err <> 0 Then 'Excel not installed
		Err.Clear
		On Error GoTo 0
		Exit Sub
	End If 
	
	'oXL.Visible = True
	oXL.DisplayAlerts=False ' don't display overwrite prompt.
	oXL.Workbooks.Open(strFileName)
	Set objRange = oXL.Worksheets(1).UsedRange
	objRange.EntireColumn.Autofit()

	Dim oWS	
	Set oWS = oXL.Worksheets(1)
	oWS.Activate
	oWS.Name = sdomain
	
	oXL.ActiveWorkBook.SaveAs strFileName,xlnormal,,,,,,,True 'overwrite existing
	oXL.ActiveWorkBook.Close
	oXL.Quit
	'WScript.Echo "Done"
End Sub 


Sub echoandlog (message)
	message = Replace(message,"GC://","LDAP://")
	'Echo output and write to Log
	Wscript.Echo message
	AppendOut.WriteLine message
End Sub  

Function IsCScript()
    If (InStr(UCase(WScript.FullName), "CSCRIPT") <> 0) Then
        IsCScript = True
    Else
        IsCScript = False
    End If
End Function