Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

FULL Active Directory Search

Status
Not open for further replies.

BKearan

IS-IT--Management
Sep 27, 2007
45
US
Problem : Our Active Directory implementation is... er.. crap.
The OU structure is loose, complicated and not followed very well. So, computers are in all kinds of OUs and from what I can tell, some computers are not in any...
I need to do a FULL search of the domain, but, just getting the script below, which does a great job on that ONE OU, has turned my brain to mush...

Currently searching the OU using : GetObject("LDAP://OU=workstations,OU=mynetwork,dc=mydomain,dc=local")

Need to search every OU in :
GetObject("LDAP://dc=mydomain,dc=local")

I found :
You might also want to do a recursive search, that is, search in all the OUs within an OU.

For this you need to create a subroutine which can call itself.

Set TopLevel = GetObject ("LDAP://OU=Domain Users,DC=sunnydale,DC=muni")
Contacts = 0
Users = 0
CountUsersContacts (TopLevel)

Sub CountUsersContacts (ObjOU)
For Each FoundObject in ObjOU
Select Case FoundObject.class
Case "user"
Users = Users + 1
Case "contact"
Contacts = Contacts +1
Case "organizationUnit","container"
CountUsersContacts (FoundObject)
End Select
Next

But, I can't seem to put the two together at the moment (and I have a number of other projects going... ). Any ideas?

Code:
Option Explicit


'----- Customize the following constants for your needs -----
Const ResultsFile = "DomainCollected.csv"
Const ScriptVersion = 1.0
Const JobSleep = 35000				'Time to sleep between jobs, in milliseconds
Const OpenAsASCII = 0
Const FailIfNotExist = 0
Const ForReading = 1
Const ForWriting = 2

Dim objFSO, strFileEntry, strPCName, objShell
Dim ListFile, LogFile, objOU, strComputer, strObject
Dim sTempFile, fFile, strDesc, strOS, strOSsp, strOSv
Dim strChange, strTunerPath, strTuner, IsAlive, filesys

'----- Script Banner -----
WScript.Echo
WScript.Echo ("********************************************************")
WScript.Echo
WScript.Echo "Start Asset Scan script version " & ScriptVersion
WScript.Echo "Starting Timestamp: " & Now
WScript.Echo

Set objFSO = CreateObject("Scripting.FileSystemObject")  
Set LogFile = objFSO.OpenTextFile(ResultsFile, ForWriting, True)

If Err.Number <> 0 Then
    wscript.echo ("ERROR:  Unable to initialize requested log file, " & ResultsFile & ".")
    wscript.echo ("        Please make sure that the path is valid.")
    WScript.Echo
    WScript.Echo ("        Error Code was " & Err.Number & " with description: " & Err.Description & ".")
    ListFile.Close
    Set objFSO = Nothing
    wscript.quit(2)
End If 'Err.Number <> 0

LogFile.WriteLine "Computer Name" & ",OS" & ",Last Changed" & ",Ping?" & ",Tuner?"

Set objOU = GetObject("LDAP://OU=workstations,OU=mynetwork,dc=mydomain,dc=local")
ObjOU.Filter = Array("Computer")
For each StrObject in objOU
'On Error Resume Next
	strComputer = (StrObject.cn)
	wscript.echo "Working on " & strComputer
	strOS = (StrObject.operatingSystem)
    strOSsp = (StrObject.operatingSystemServicePack)
    strOSv = (StrObject.operatingSystemVersion)
    wscript.echo "     " & strOS & " " & strOSsp & " " & strOSv
    strChange = (StrObject.whenChanged)
    wscript.echo "     " & strChange
    LogFile.WriteLine 
    strTunerPath = "\\" & strComputer & "\C$\program files\marimba\tuner\Tuner.exe"
	    Set objShell = CreateObject("WScript.Shell")
    	Set objFSO = CreateObject("Scripting.FileSystemObject")
    	sTempFile = objFSO.GetSpecialFolder(2).ShortPath & "\" & objFSO.GetTempName
    	objShell.Run "%comspec% /c ping.exe -n 2 -w 500 " & strComputer & ">" & sTempFile, 0 , True
    	Set fFile = objFSO.OpenTextFile(sTempFile, ForReading, 0, OpenAsASCII)
    	Select Case InStr(fFile.ReadAll, "TTL=")
         Case 0
            IsAlive = "Not Responding"
         Case Else
            IsAlive = "Responding"
    	End Select
    	If IsAlive = "Responding" Then
	    	Set filesys = CreateObject("Scripting.FileSystemObject")
    		strTuner = filesys.FileExists(strTunerPath)
    	Else
    		strTuner = "No Tuner"
    	End If
    LogFile.WriteLine strComputer & "," & strOS & " " & strOSsp & " " & strOSv & "," & strChange & "," & IsAlive & "," & strTuner
Next

' Clean up.

LogFile.Close

set LogFile = Nothing
Set ListFile = Nothing
Set objFSO = Nothing

WScript.Echo 
WScript.Echo "Ending Timestamp: " & Now
WScript.Echo ("********************************************************")
WScript.Echo
WScript.Quit
 
Actuall, dm4ever, my eyes are crossing from research... so... I just threw a few of the OUs in an array :

Code:
searchOUs(0) = "OU=Stale Workstation Accounts,OU=mynetwork"
searchOUs(1) = "OU=computers"
searchOUs(2) = "OU=subcompany Workstations,OU=workstations,OU=mynetwork"
searchOUs(3) = "OU=subcompany Executive Workstations,OU=workstations,OU=mynetwork"
searchOUs(4) = "OU=PCSERVICES,OU=workstations,OU=mynetwork"
searchOUs(5) = "OU=Special Assets,OU=workstations,OU=mynetwork"
searchOUs(6) = "OU=WSOSAPPSTESTGROUP,OU=workstations,OU=mynetwork"
searchOUs(7) = "OU=workstations,OU=mynetwork"

For each strOU in SearchOUs
	Set objOU = GetObject("LDAP://" & strOU & ",dc=mydomain,dc=local")
	ObjOU.Filter = Array("Computer")

... lazy, I suppose, but... :D Only, I can't seem to get to OU=Computers... not sure why.
 
Here is a way:

Code:
Set TopLevel = GetObject("LDAP://DC=sunnydale,DC=muni")
    Contacts = 0
    Users = 0
    Computers = 0
    CountUsersContacts (TopLevel)


Sub CountUsersContacts (ObjOU)
    For Each FoundObject in ObjOU
          Select Case FoundObject.class
                Case "user"
                     Users = Users + 1
                Case "contact"
                     Contacts = Contacts +1
		Case "computer"
		      Computers = Computers + 1
                Case "organizationUnit","container"
                     CountUsersContacts (FoundObject)    
    	   End Select 
    Next
End Sub

Seemed to work alright
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top