Re: Multiple OU's?
- From: Dan <Dan@xxxxxxxxxxxxxxxxxxxxxxxxx>
- Date: Sun, 27 Aug 2006 21:40:02 -0700
Hey Richard,
Well, almost there... here's the code I have as of now.. getting an error
about it not being a collection... it works with a single OU in the array but
something is up with adding multiple values to the array... any ideas?
Dim x, zz
Set objRoot = GetObject("LDAP://RootDSE";)
strDNC = objRoot.Get("DefaultNamingContext")
Set fso = CreateObject("Scripting.FileSystemObject")
Set txtstream = fso.CreateTextFile("c:\testfile.txt", True)
arrOUs = Array("ou=ou1,dc=ad,dc=pstntest,dc=com", _
"ou=ou2,dc=ad,dc=pstntest,dc=com", _
"ou=ou3,dc=ad,dc=pstntest,dc=com")
For Each strOU In arrOUs
Set objOU = GetObject("LDAP://"; & strOU)
Call EnumMembers(objOU)
Next
Sub enumMembers(objOU)
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.
' I set AD properties to variables so if needed you could do Null checks or
add if/then's
to this code
' this was done so the script could be modified easier.
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
"Richard Mueller" wrote:
Sorry, what I posted was just a rough outline. You need to bind to the OU.
objects, since you pass the OU object to the sub EnumMembers (not just the
name of the OU). Perhaps put the Distinguished Names of the OU's in the
array, then bind to the OU object and pass this object reference to the sub:
arrOUs = Array("ou=OU1,dc=ad,dc=pstntest,dc=com", _
"ou=OU3,dc=ad,dc=pstntest,dc=com", _
"ou=OU7,dc=ad,dc=pstntest,dc=com")
For Each strOU In arrOUs
Set objOU = GetObject("LDAP://"; & strOU)
Call EnumMembers(objOU)
Next
I have not reviewed the rest of your code, but I would recommend commenting
out "On Error Resume Next", as it could be masking problems.
--
Richard
Microsoft MVP Scripting and ADSI
Hilltop Lab - http://www.rlmueller.net
<dankennedy24@xxxxxxxxx> wrote in message
news:1156721304.310752.321830@xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Hey Richard,
Thanks for the reply.... here's where I am, unfortunately I'm not
getting any records returned... any thoughts? Basically, what I'm
thinking is to bind to the top of the domain and look for the OU's from
there....
Dim x, zz
Set objRoot = GetObject("LDAP://RootDSE";)
strDNC = objRoot.Get("DefaultNamingContext")
Set objOU = GetObject("LDAP://dc=ad,dc=pstntest,dc=com";)
' Bind to the top of the Domain using LDAP using ROotDSE
Set fso = CreateObject("Scripting.FileSystemObject")
Set txtstream = fso.CreateTextFile("c:\testfile.txt", True)
arrOUs = Array("OU1", "OU3")
For each strOU In arrOUs
Call EnumMembers(strOU)
Next
Sub enumMembers(strOU)
On Error Resume Next
Dim Secondary(20) ' Variable to store the Array of 2ndary email alias's
For Each objMember In strOU ' go through the collection
If ObjMember.Class = "user" Then ' if not User object, move on.
' I set AD properties to variables so if needed you could do Null
checks or add if/then's
to this code
' this was done so the script could be modified easier.
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
Richard Mueller wrote:
Hi,
If you know the names of the OU's, you can hardcode the names in an array
and loop through the array. For example:
arrOUs = Array("OU1", "OU3", "OU7")
For each strOU In arrOUs
Call EnumMembers(strOU)
Next
Otherwise, you can bind to the domain object and use a recursive
subroutine
to enumerate all OU's in the domain. For example:
Set objDomain = GetObject("LDAP://dc=ad,dc=company,dc=com";)
Call EnumOUs(objDomain)
Sub EnumOUs(objParent)
Call EnumMembers(objParent)
objParent.Filter = Array("organizationalUnit", "container")
For Each objChild In objParent
Call EnumOUs(objChild)
Next
End Sub
--
Richard
Microsoft MVP Scripting and ADSI
Hilltop Lab - http://www.rlmueller.net
<dankennedy24@xxxxxxxxx> wrote in message
news:1156695690.304470.65650@xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
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
- References:
- Multiple OU's?
- From: dankennedy24
- Re: Multiple OU's?
- From: Richard Mueller
- Re: Multiple OU's?
- From: dankennedy24
- Re: Multiple OU's?
- From: Richard Mueller
- Multiple OU's?
- Prev by Date: Re: Multiple OU's?
- Next by Date: IF statement help..
- Previous by thread: Re: Multiple OU's?
- Next by thread: Can someone recommend a good VBScript book?
- Index(es):
Relevant Pages
|
