Multiple OU's?

Hi,
In the scribt below, it is it possible to have the 'GetObject' pull
separate distinct OU's? As you can see I am cuurently pulling from
"OU1" and that works like a champ, however, what if I'd like to pull
from "OU1", "OU3" and "OU7"? I know I can get the entire domain but
that's overkill for what I want in the result set. If it's not
possible to usee 'GetObject' any other good way to get the other OU's
included in the results?


Dim x, zz
Set objRoot = GetObject("LDAP://RootDSE";)
strDNC = objRoot.Get("DefaultNamingContext")
Set objOU = GetObject("LDAP://ou=OU1,dc=ad,dc=company,dc=com";)

Set fso = CreateObject("Scripting.FileSystemObject")
Set txtstream = fso.CreateTextFile("c:\testfile.txt", True)

Call enummembers(objOU)
Sub enumMembers(objOU)
On Error Resume Next
Dim Secondary(20) ' Variable to store the Array of 2ndary email alias's

For Each objMember In objOU ' go through the collection

If ObjMember.Class = "user" Then ' if not User object, move on.

EmailAddr = objMember.mail

zz = 1 ' Counter for array of 2ndary email addresses
For each email in ObjMember.proxyAddresses
If Left (email,5) = "SMTP:" Then
Primary = Mid (email,6) ' if SMTP is all caps, then it's the Primary
ElseIf Left (email,5) = "smtp:" Then
Secondary(zz) = Mid (email,6) ' load the list of 2ndary SMTP
emails into Array.
zz = zz + 1
End If
Next

txtstream.write Primary & vbcrlf

' Write out the Array for the 2ndary email addresses.
For ll = 1 To 20

txtstream.write Secondary(ll) & vbcrlf


Next
' Blank out Variables in case the next object doesn't have a value for
the property

Primary = "-"
For ll = 1 To 20
Secondary(ll) = ""
Next
End If

' If the AD enumeration runs into an OU object, call the Sub again to
itinerate

If objMember.Class = "organizationalUnit" or OBjMember.Class =
"container" Then
enumMembers (objMember)
End If


Next
End Sub


txtstream.close

Const ForReading = 1
Const ForWriting = 2

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("C:\Testfile.txt", ForReading)

Do Until objFile.AtEndOfStream
strLine = objFile.Readline
strLine = Trim(strLine)
If Len(strLine) > 0 Then
strNewContents = strNewContents & strLine & vbCrLf
End If
Loop

objFile.Close

Set objFile = objFSO.OpenTextFile("C:\Testfile.txt", ForWriting)
objFile.Write strNewContents
objFile.Close

MsgBox "Done" ' show that script is complete

.

Relevant Pages

  • Help with Script...
    ... The following script works like a charm to pull all of the email addy's ... strLine = Trim ... strNewContents = strNewContents & strLine & vbCrLf ...
    (microsoft.public.exchange.admin)
  • Re: Importing a Text File Into 1 Column
    ... You could set up the macro below which would pull the strings from the text file and place them down Column A of the active sheet. ... Set objFile = objFSO.OpenTextFile ... strLine = Replace ...
    (microsoft.public.excel.misc)
Loading