Script to delete SMTP proxy addresses added by Recepient policy

'======================================================================================='' AUTHOR: Anthony Drewery'' DATE: 19th October 2006'' COMMENT: Removes proxy addresses for specific SMTP domains'=======================================================================================
Const ForWriting = 2Const ForReading = 1Const ADS_PROPERTY_DELETE = 4
'Path for the output fileoutputfilePath = "C:\processlog.txt"
'Path for input fileinputfilepath = "c:\users.txt"
'Path for address loglogfilepath = "c:\addresslog.txt"
'Domain to be processesstrSMTPDomain = "lykeslines.com"intSDLen = Len(strSMTPDomain)
'Setup input fileSet objFSO = CreateObject("Scripting.FileSystemObject")Set objInTextFile = objFSO.OpenTextFile(inputfilepath, ForReading, True)
'Setup output fileSet objFSO = CreateObject("Scripting.FileSystemObject")Set objTextFile = objFSO.OpenTextFile(outputfilepath, ForWriting, True)
'Setup log fileSet objFSO = CreateObject("Scripting.FileSystemObject")Set objAdLogTextFile = objFSO.OpenTextFile(logfilepath, ForWriting, True)
'Create Objects for LDAP QueriesSet rootDSE = GetObject("ldap://RootDSE/")DomainContainer = rootDSE.Get("defaultNamingContext")
Set conn = CreateObject("ADODB.Connection")conn.Provider = "ADSDSOObject"conn.Open "ADs Provider"
'Read name from input fileDo Until objInTextFile.AtEndOfStream
strDisplayName = objInTextFile.ReadLine 'Find the user in AD using an LDAP query strLDAP = ";(&(objectCategory=person)(objectClass=user)(displayName=" & strDisplayName & "));adspath;subtree"
'Get query results and output to file Set oComm = CreateObject("ADODB.Command") oComm.ActiveConnection = conn oComm.CommandText = strLDAP oComm.Properties("Sort on") = "DisplayName" oComm.Properties("Page size") = 1500
Set rs = oComm.Execute AddCount = 0 If rs.recordcount = 0 then QueryResult = "User not found" objTextFile.WriteLine(strDisplayName & vbtab & QueryResult) End If
If rs.recordcount > 1 then QueryResult = "Resolved to more than one name" objTextFile.WriteLine(strDisplayName & vbtab & QueryResult) End If
If rs.recordcount = 1 then QueryResult = "User found" While Not rs.EOF Set FoundObject = GetObject (rs.Fields(0).Value) arrProxyAddresses = FoundObject.proxyAddresses For Each Address In arrProxyAddresses 'Confirm that the address is for the SMTP somain you want to process If left(Address,5)= "smtp:" And Right(LCase(Address),intSDLen)= strSMTPDomain Then objAdLogTextFile.WriteLine(FoundObject.Displayname & vbTab & Address) 'Strip the address from the array FoundObject.PutEx ADS_PROPERTY_DELETE, "proxyAddresses", Array(Address) FoundObject.SetInfo AddCount = AddCount + 1 End if Next rs.MoveNext Wend objTextFile.WriteLine(strDisplayName & vbtab & QueryResult & vbTab & AddCount & " addresses removed") End If Loop
MsgBox "Processing complete!"