I recently sent out a newsletter to everyone who had any communicatoin with RealCajunRecipes.com. I had an Exchange Mailbox that collected all emails sent using the Tell-A-Friend feature of the website as well as the guestbook, ask maw-maw, and general website comments. I'd forgotten to automatically subscribe these users to the newsletter application and so I back tracked using this handy script.
Note: the name of the mailbox containing all of the emails is named RealCajunRecipes which is associated with the Active Directory account Chrissy theMayor. The SQL Server table which contained the newsletter subs is appropriately named newslettersubs.
'****************************************************************************
' This script created by Chrissy LeMaire (clemaire@gmail.com)
' Website: http://netnerds.net/
'
' NO WARRANTIES, etc.
'
' This script processes an Exchange mailbox for email addresses
' and adds them to a SQL Server table
'
' Requirements -- access to the Exchange mailbox and an SQL
' table
'
' This script has only been tested on Exchange Server 2003.
'
' "What it does"
' 1. Opens the Exchange profile "MS Exchange Profile"
' 2. Opens the mail store "Mailbox - Chrissy theMayor"
' 3. Opens the mailbox "RealCajunRecipes"
' 4. Iterates through the box collecting email addresses
' 5. Adds email to SQL table if it doesnt already exist
'
'*****************************************************************************
Const ConnString = "Provider=SQLOLEDB; Data Source=sql; Initial Catalog=realcajun;Trusted_Connection=yes;"
set oSession=CreateObject("MAPI.Session")
oSession.Logon "MS Exchange Profile"
Set objInfoStores = oSession.InfoStores 'hi my Name is bear
For i = 1 To objInfoStores.Count
If objInfoStores.Item(i)= "Mailbox - Chrissy theMayor" Then
Set objInfoStore = objInfoStores.Item(i)
Set objRootFolder = objInfoStore.RootFolder
' Open the RealCajunRecipes folder
Set objFolder = objRootFolder.Folders("RealCajunRecipes")
set objMessages = objFolder.Messages
For j = 1 To objMessages.Count
Set omsg = objMessages.Item(j)
theEmail = omsg.Sender
If AdditBool(theEmail,Connstring) = True Then
Call Addit(theEmail,Connstring)
End if
For each recipient in omsg.recipients
If AdditBool(recipient,Connstring) = True Then
Call Addit(recipient,Connstring)
End if
Next
Next
Exit For
End If
Next
Function AdditBool(theEmail,theConnString)
If InStr(theEmail,"@") = 0 or InStr(theEmail,"netnerds") > 0 or InStr(theEmail,"mymomma") > 0 or InStr(theEmail,"'") > 0 Then
AdditBool = False
Exit Function
End If
Set rsEmailCheck = CreateObject("adodb.recordset")
strSQL = "select id from newsletterSubs where email = '" & theEmail & "'"
rsEmailCheck.Open strSQL, theConnString, 1, 1
If rsEmailCheck.eof and rsEmailCheck.bof Then
AdditBool = True
Else
AdditBool = False
Exit Function
End If
rsEmailCheck.Close
strSQL = "select id from newsletterNoSubs where email = '" & theEmail & "'"
rsEmailCheck.Open strSQL, Connstring, 1, 1
If rsEmailCheck.eof and rsEmailCheck.bof Then
AdditBool = True
Else
AdditBool = False
Exit Function
End If
rsEmailCheck.Close
Set rsEmailCheck = Nothing
End Function
Sub Addit(theEmail,theConnString)
Set Conn = CreateObject("adodb.connection")
strSQL = "insert into newsletterSubs (email,dateAdded,ipaddr) values ('" & theEmail & "','5/24/2004','10.0.0.102')"
Conn.Open theConnString
Conn.execute StrSQL
Conn.close
Set Conn = Nothing
'MsgBox theEmail
End Sub