Exchange: Exporting SMTP Proxies Part 2

Summary:

The following script will export SMTP proxies from the specific OU's that you designate rather than exporting the entire domain.

You can also download this file from our ftp site at:

ftp://ftp.smtp25.org/[ James Chong Scripts ]


Dim x, zz
Set objRoot = GetObject("LDAP://RootDSE")
Set fso = CreateObject("Scripting.FileSystemObject")
Set txtstream = fso.CreateTextFile("c:\testfile.txt", True)
strDNC = objRoot.Get("DefaultNamingContext")
Set objOU = GetObject("LDAP://cn=users,dc=corp,dc=company,dc=net")
Call enummembers(objOU)
Set objOU = GetObject("LDAP://cn=builtin,dc=corp,dc=company,dc=net")
Call enummembers(objOU)

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.

' 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



James Chong
MCSE M+, S+, MCTS, Security+
msexchangetips.blogspot.com


How useful was this article? Want to see a tip not listed? Please leave a comment.