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"" <chrissy@netnerds.net>" 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>