Error sending emails in VBA within a Loop

R

Rick Cassani

I'm trying to send a mass email to all my customers. I've written the
routine below to loop through the file containing the email addresses and
send the email. The first email send fine but I get an error on the
".Recipients.Add strRecipient" statement on the subsequent pass through. The
error is: "The item has been moved or deleted".

Any suggestions as to why this is happening and how to fix it?

cmd.CommandText = "SELECT SY01200.*, RM00101.CUSTNAME FROM SY01200 INNER
JOIN RM00101 ON SY01200.Master_ID = RM00101.CUSTNMBR WHERE SY01200.INET1 <>
'' AND SY01200.Master_Type = 'CUS'"
Set rst = cmd.Execute
rst.MoveFirst
Do Until rst.EOF = True
'strRecipient = trim(rst!INET1)
strRecipient = "shipping"
strMsg = "<font face=arial><h2>This is a test email.</h2>
<p><b>Customer:</b><i> " & Trim(rst!CUSTNAME) &
"</i><br><b>Email:</b><i> " & strRecipient & "</i><p>It has been generated
automatically from our system in preparation for the new Replenishment
program. <p>Please <b>do not reply</b> to this email. <p>Thank
You,<br>Tornier Customer Service</font>"
With appNewMail
.Recipients.Add strRecipient
.Subject = strSubject
.HTMLBody = strMsg
.Send
End With
EmailCounter = EmailCounter + 1
rst.MoveNext
Loop
cn.Close
 
Top