Using Tokens in e-Mail

[BamaColtsFan]

Okay gang... I hate to drop a big one on you like this but I'm stumped as to why this doesn't do what I expect it to. I am using a nifty little piece of code I found at http://www.jephens.com/2007/05/13/how-to-send-e-mail-from-ms-access-using-outlook which uses MS Outlook to send e-mail messages based on a list from my database using a text file as a template. What it is supposed to do is go through the records in a query (MyEmailAddresses) and send a customized message to each recipient.

For testing purposes I am only replacing two values (name and status) using data from the query but eventually, there will be a lot more replacement.

What is acutally happening is that the code sends out the messages, one each to every receipient in the query, but it is not replacing the text for each record. The messages have the name and status from the first record shown on every message sent (everyone gets the same name and status). It is very odd to me that I know the loop is going through all the records because it is getting all the email addresses. I just can't figure out why it's not replacing the text each time it finds a new record.... Any advice, as always, is deeply appreciated!

Public Function SendEMail()

Dim db As DAO.Database
Dim MailList As DAO.Recordset
Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim Subjectline As String
Dim BodyFile As String
Dim fso As FileSystemObject
Dim MyBody As TextStream
Dim MyBodyText As String
Dim MyNewBodyText As String
Dim newPath As DAO.Recordset
Dim strPath As String
Dim strFileName As String
Set db = CurrentDb()
Set newPath = db.OpenRecordset("Set_Path")
strFileName = "Mail Merge - Mail Test.txt"
strPath = newPath!path & strFileName
Set fso = New FileSystemObject
Subjectline$ = "Daily Status"

If Subjectline$ = "" Then
MsgBox "No subject line, no message." & vbNewLine & vbNewLine & _
"Quitting...", vbCritical, "E-Mail Merger"
Exit Function
End If

BodyFile$ = strPath

If BodyFile$ = "" Then
MsgBox "No body, no message." & vbNewLine & vbNewLine & _
"Quitting...", vbCritical, "I Ain’t Got No-Body!"
Exit Function
End If

If fso.FileExists(BodyFile$) = False Then
MsgBox "The body file isn’t where you say it is. " & vbNewLine & vbNewLine & _
"Quitting...", vbCritical, "I Ain’t Got No-Body!"
Exit Function
End If

Set MyBody = fso.OpenTextFile(BodyFile, ForReading, False, TristateUseDefault)

MyBodyText = MyBody.ReadAll
MyBody.Close

Set MyOutlook = New Outlook.Application

Set db = CurrentDb()

Set MailList = db.OpenRecordset("MyEmailAddresses")

MyNewBodyText = MyBodyText
MyNewBodyText = Replace(MyNewBodyText, "[[Name]]", MailList("Employee Name"))
MyNewBodyText = Replace(MyNewBodyText, "[[Status]]", MailList("Status"))

Do Until MailList.EOF

Set MyMail = MyOutlook.CreateItem(olMailItem)
MyMail.To = MailList("email")
MyMail.Subject = Subjectline$
MyMail.Body = MyNewBodyText
MyMail.Display

MailList.MoveNext

Loop

Set MyMail = Nothing
Set MyOutlook = Nothing

MailList.Close
Set MailList = Nothing
db.Close
Set db = Nothing

End Function

 

[pbaldy]

You're going to kick yourself. You set those values before the loop starts. You need to do it within the loop.

 

[joh024]

MyNewBodyText = MyBodyText
MyNewBodyText = Replace(MyNewBodyText, "[[Name]]", MailList("Employee Name"))
MyNewBodyText = Replace(MyNewBodyText, "[[Status]]", MailList("Status"))
 
Do Until MailList.EOF
 
Set MyMail = MyOutlook.CreateItem(olMailItem)
MyMail.To = MailList("email")
MyMail.Subject = Subjectline$
MyMail.Body = MyNewBodyText
MyMail.Display
 
MailList.MoveNext
 
Loop

You didn't seem to include the replace within the loop. So it only gets updated one time before the loop. not at each record.

 

[BamaColtsFan]

At the risk of sounding a little too dense, where would you suggest placing the replace statements? I've moved them around several places and still can't get it right. It seems like I just keep guessing wrong....

 

[pbaldy]

After this line:

Do Until MailList.EOF

but before

MyMail.Body = MyNewBodyText

 

[BamaColtsFan]

Okay... now I got it! I had tried moving the replace sataements but I was not moving the MyNewBodyText = MyBodyText line with them. Once I moved all three inside the loop, it appears to work! Thanks yet again guys!!!