General discussion

Locked

Change my code to send email

By lmerrill ·
My code sends an email & attachment to a list from an Access query. But it puts ALL addressees into 1 TO field and sends. I need to change the code to send the email & attachment to each person on list one at a time. If you want the mdb file I created -email me
--code--
Private Sub Command0_Click()
Dim dbs As Database, rst As Recordset
Dim strSQL As String
Dim CurrentEmailAddress As String
Dim strTitle As String
Dim strMessage As String
Dim Crt As String
Dim objoutlook As Outlook.Application
Dim objoutlookmsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Crt = Chr(13) & Chr(10)
Dim RecCount
RecCount = 0

strTitle = [txtSubject]
Set objoutlook = CreateObject("Outlook.Application")
Set objoutlookmsg = Outlook.CreateItem(olMailItem)

Set dbs = CurrentDb
strSQL = "SELECT Query1.FirstName, Query1.LastName, Query1.Email, Query1.Flag FROM Query1 WHERE (((Query1.Flag)=Yes));"

Set rst = dbs.OpenRecordset(strSQL)

Do While Not rst.EOF
CurrentEmailAddress = rst.Fields(2)

With objoutlookmsg
Me!Alert = "Now sending email to" & Chr(13) & Chr(10) & rst.Fields(0) & " " & rst.Fields(1)

(CurrentEmailAddress) Set objOutlookRecip = .Recipients.Add(CurrentEmailAddress)
objOutlookRecip.Type = olTo
End With
rst.MoveNext
Loop

With objoutlookmsg
.Subject = strTitle
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add("C:\my documents\Customers.doc")
End If

'resolve the recipients >>>
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next

.Display
.Send
End With
rst.Close
dbs.Close
Me!Alert = "Done - All EMail Sent"

End Sub

This conversation is currently closed to new comments.

3 total posts (Page 1 of 1)  
| Thread display: Collapse - | Expand +

All Comments

Collapse -

Change my code to send email

by Stillatit In reply to Change my code to send em ...

You are looping through all addersses, then sending an email. You need to move the two lines:
rst.MoveNext
Loop
to just before the line:
rst.Close

I really hope this is not a spam generator...

Good luck.

Collapse -

Change my code to send email

by lmerrill In reply to Change my code to send em ...

Richard's extra effort -actually solved the problem by moving 1 line of code. Microsoft Tech support have been trying to solve this for 2 months.
Thanks Richard!

Collapse -

Change my code to send email

by lmerrill In reply to Change my code to send em ...

This question was closed by the author

Back to Web Development Forum
3 total posts (Page 1 of 1)  

Related Discussions

Related Forums