issues with looping using Outlook for sending emails via Access

[Miskacee]

I am trying to send an email via outlook from access. I have a table that
holds email addresses and an employee name. I am putting the employee name
on the subject line - each email address has a different employee name.

I am having issues with looping. Whenever I click the command button, the
first records works correctly, then I get an error message: " The Item has
been Moved or Deleted."

Can anyone offer suggestions or correct my code below?

Thank you!!!


Private Sub cmdOutlook_Click()

Dim strsql As String
Dim objOutlook As Outlook.Application
Dim objEmail As Outlook.MailItem

Set objOutlook = CreateObject("Outlook.application")
Set objEmail = objOutlook.CreateItem(olMailItem)

Set db = CurrentDb
Set rst = db.OpenRecordset("SELECT * FROM tmp_Email")
'------------
'-----------
With Me.RecordsetClone
If .RecordCount > 0 Then
.MoveFirst
End If
End With

Do While Not rst.EOF
With objEmail
.To = Me.emailaddress
.Subject = Me.txtSubject & " - " & Me.employee
.Body = Me.txtEmail
.Send
End With

rst.MoveNext
Loop
'----------
Debug.Print
Set rst = Nothing

On Error Resume Next
rst.Close

Exit_Here:
Set objOutlook = Nothing

End Sub

 

[dch3]

For each email, you'll be creating a new email object. Place the Set objEmail
= objOutlook.CreateItem(olMailItem) statement within Do While loop.
Also see my inline comment below.

I am trying to send an email via outlook from access. I have a table that
holds email addresses and an employee name. I am putting the employee name
on the subject line - each email address has a different employee name.

I am having issues with looping. Whenever I click the command button, the
first records works correctly, then I get an error message: " The Item has
been Moved or Deleted."

Can anyone offer suggestions or correct my code below?

Thank you!!!


Private Sub cmdOutlook_Click()

Dim strsql As String
Dim objOutlook As Outlook.Application
Dim objEmail As Outlook.MailItem

Set objOutlook = CreateObject("Outlook.application")
Set objEmail = objOutlook.CreateItem(olMailItem)

Set db = CurrentDb
Set rst = db.OpenRecordset("SELECT * FROM tmp_Email")
'------------
'-----------

'Why do you have this - the code doesn't do anything

 

[Miskacee]

Still have an issue. I have 4 records and now it is just sending the first
email 4 times and not looping to the next email.

please assist!!! Thank you so much in advance!

I have changed to the following:
Do While Not rst.EOF

Set objEmail = objOutlook.CreateItem(olMailItem)
With objEmail
.To = Me.emailaddress
.Subject = Me.txtSubject & " - " & Me.employee
.Body = Me.txtEmail
.Send
End With
rst.MoveNext
Loop

 

[dch3]

Change the Me. to rst.

ME. points to the form (or report) RST. will point back to the recordset.

 

[Miskacee]

Thank you thank you thank you!!!! That worked! I knew it was something
little but couldn't figure it out.