Exchange: Exporting SMTP Proxies Part 2
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")
Set objOU = GetObject("LDAP://cn=builtin,dc=corp,dc=company,dc=net")
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
txtstream.write Primary & vbcrlf
' Write out the Array for the 2ndary email addresses.
For ll = 1 To 20
txtstream.write Secondary(ll) & vbcrlf
' Blank out Variables in case the next object doesn't have a value for the property
Primary = "-"
For ll = 1 To 20
Secondary(ll) = ""
' If the AD enumeration runs into an OU object, call the Sub again to itinerate
If objMember.Class = "organizationalUnit" or OBjMember.Class = "container" Then
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
Set objFile = objFSO.OpenTextFile("C:\Testfile.txt", ForWriting)
MsgBox "Done" ' show that script is complete
MCSE M+, S+, MCTS, Security+
How useful was this article? Want to see a tip not listed? Please leave a comment.