VBScript: Track Outbound E-mail Addresses in Exchange

I use the code below to extract e-mail addresses from outbound e-mails and insert them into a SQL table. This is useful when using custom Exchange/SQL Server solutions to put a lid on spam ;D

Exchange Sink

<script LANGUAGE="VBScript">
Sub ISMTPOnArrival_OnArrival(ByVal Msg, EventStatus )
On Error Resume Next
EventStatus = 0 'Run the next sink by default.

Connstring = "Driver={SQL Server}; Server=servername; Database=dbname; UID=username; PWD=mypass"

Set envfields = Msg.EnvelopeFields
Set fields = Msg.Fields
RecipList = LCase(envfields("http://schemas.microsoft.com/cdo/smtpenvelope/recipientlist"))
IpAddr =   LCase(envfields("http://schemas.microsoft.com/cdo/smtpenvelope/clientipaddress"))
Sender =   LCase(fields.Item("urn:schemas:mailheader:from"))

recipList = replace(LCase(RecipList),"smtp:","")
recipArray = split(RecipList,";")

For aa = LBound(recipArray) To UBound(recipArray)
If Len(recipArray(aa)) > 0  and Len(ipaddr) = 0 and Sender = """chrissy lemaire"" <[email protected]>" Then
Set rs = CreateObject("adodb.recordset")
strSQL = "select whiteline from whitelist where whiteline = '" & recipArray(aa) & "'"
rs.Open strSQL,Connstring,1,2
If rs.eof and rs.bof Then
rs.Addnew
rs("whiteline") = recipArray(aa)
rs.Update
End If
rs.close
Set rs = nothing
End If
Next

Msg.DataSource.Save
EventStatus = 0 'cdoRunNextSink
End Sub
</script>

Chrissy is a PowerShell MVP who has worked in IT for nearly 20 years, and currently serves as a Sr. Database Engineer in Belgium. Always an avid scripter, she attended the Monad session at Microsoft’s Professional Developers Conference in Los Angeles back in 2005 and has worked and played with PowerShell ever since. Chrissy is currently pursuing an MS in Systems Engineering at Regis University and helps maintain RealCajunRecipes.com in her spare time. She holds a number of certifications, including those relating to SQL Server, SuSE Linux, SharePoint and network security. She recently became co-lead of the SQL PASS PowerShell Virtual Chapter. You can follow her on Twitter at @cl.

Posted in Exchange, VBScript
One comment on “VBScript: Track Outbound E-mail Addresses in Exchange
  1. Jerod says:

    Hi-

    This is interesting as I am trying to implement an auto-whitelist based on outbound email sent from the Exchange Server.

    Can you show how to register this Exchange Sink? Thanks

Leave a Reply

Your email address will not be published. Required fields are marked *

*