Sending email messages with loop sends same record each time

[Denae]

I have code that is sending an email then updating a table with the date/time the email was sent, it is sending the first record and looping the right number of times (there are 3 email messages to be sent so it sends 3) but it is repeating the data in the first record instead of moving to the next record. It is also logging in the tracking table that the message was sent 3 times but for the same record.

Any help is greatly appreciated:

Private Sub cmdSendEmail_Approval_Click()

'LOOP STATEMENT

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM qryEmail_Approval_ALL")
    
Dim MyTrackingTable As Recordset
Set MyTrackingTable = CurrentDb.OpenRecordset("tblTerminationData_ActionsCompleted")

'Check to see if the recordset actually contains rows
If Not (rs.EOF And rs.BOF) Then
    rs.MoveFirst 'Unnecessary in this case, but still a good habit
    Do Until rs.EOF = True
    
'LOOPING ACTION - SEND EMAIL
         Dim strEmail, strBody As String
         Dim objOutlook As Outlook.Application
         Dim objEmail As Outlook.MailItem
    

        
        '**creates an instance of Outlook
        Set objOutlook = CreateObject("Outlook.application")
        Set objEmail = objOutlook.CreateItem(olMailItem)
        
        '**************************************************************
        '*create string with email address
        
        strID = SelectedTermination
        strEmail = strTo
        strBody = strConsolidatedBody
        
        '***creates and sends email
    With objEmail
            .To = strTo
            .CC = strCC
            .Subject = strSubject
            .HTMLBody = strConsolidatedBody
           ' .Display
           .Send
    End With

'Add record of send to Actions Compelted table
     MyTrackingTable.AddNew
     MyTrackingTable("intTerminationID") = strID
     MyTrackingTable("intActionID") = 1
     MyTrackingTable("dtmActionPerformed") = Now()
     MyTrackingTable.Update

'Move to the next record.
    rs.MoveNext
    
Loop

Else
    MsgBox "There are no records in the recordset."
End If

MsgBox "All email messages have been sent."

rs.Close 'Close the recordset
Set rs = Nothing 'Clean up
    
End Sub

 

[SkipVought]

Hi,

‘
        '**creates an instance of Outlook
        Set objOutlook = CreateObject("Outlook.application")
        Set objEmail = objOutlook.CreateItem(olMailItem)

This code belongs BEFORE your loop. The Dim statements also belong BEFORE the loop at the top of your procedure.

You have variables for assigning your eMail objects that are never 1) declared nor 2) assigned with value(s). In fact there’s no hint of where these values would come from???

Are there some fields in the db that you’re looping thru, that have the eMail address, or a Message or other relevant data?

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Denae]

I have moved the suggested code to the beginning along with the Dim statements. But now I am getting a Run-time error, the item has been moved or deleted. When I debug it takes me to the .TO - strTo line of the code.

I have a command button on a form (frmEmail_Approval_ALL) that executes the code on click. The form is based on a query; qryEmail_Approval_ALL

The form has the following fields:
[ul]
[li]SelectedTermination[/li]
[li]strTo[/li]
[li]strCC[/li]
[li]strSubject[/li]
[li]strConsolidatedBody[/li]
[/ul]

Private Sub cmdSendEmail_Approval_Click()

'**creates an instance of Outlook
   Set objOutlook = CreateObject("Outlook.application")
   Set objEmail = objOutlook.CreateItem(olMailItem)
   
   Dim strEmail, strBody As String
' NOTE: I commented out the next two lines as they were giving me an error: "Duplicate declaration in current scope"
'   Dim objOutlook As Outlook.Application
'   Dim objEmail As Outlook.MailItem
    

'LOOP STATEMENT

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM qryEmail_Approval_ALL")
    
Dim MyTrackingTable As Recordset
Set MyTrackingTable = CurrentDb.OpenRecordset("tblTerminationData_ActionsCompleted")

'Check to see if the recordset actually contains rows
If Not (rs.EOF And rs.BOF) Then
    rs.MoveFirst 'Unnecessary in this case, but still a good habit
    Do Until rs.EOF = True
    
'LOOPING ACTION - SEND EMAIL


        '**************************************************************
        '*create string with email address
        
        strID = SelectedTermination
        strEmail = strTo
        strBody = strConsolidatedBody
        
        '***creates and sends email
    With objEmail
            .To = strTo
            .CC = strCC
            .Subject = strSubject
            .HTMLBody = strConsolidatedBody
           ' .Display
           .Send
    End With

'Add record of send to Actions Compelted table
    MyTrackingTable.AddNew
    MyTrackingTable("intTerminationID") = strID
    MyTrackingTable("intActionID") = 1
    MyTrackingTable("dtmActionPerformed") = Now()
    MyTrackingTable.Update

'Move to the next record.
    rs.MoveNext
    
Loop

Else
    MsgBox "There are no records in the recordset."
End If

MsgBox "All email messages have been sent."

rs.Close 'Close the recordset
Set rs = Nothing 'Clean up
    
End Sub

 

[SkipVought]

Use the Watch Window to inspect what’s in strTo. Also, you can inspect the .To property as long as you fullu qualify the object.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Denae]

I am still running into problems with the code, not sure how or what to inspect.

I have a button on the form (frmEmail_Approval_All) that has the records I want to "send". When I click the button the code runs to send an email using the fields on the form then adds a record to the tblTerminationData_ActionsCompelted to track that the email was sent. The fields on the form include; SelectedTermination, strTo, strCC, strSubject, strConsolidatedBody.

When I run the code the email for the first record is sent correctly and a record is added to the tblTermination_ActionsCompelted table, however it is using the same data to send the next email as in the first, it does not move to the next record and it updates the table, but it is duplicating the information from record 1. So if there are 3 records to be sent it is sending record 1 three times and logging the send 3 times. I am struggling with how to get it to loop to the next record.

The code I have is as follows:

Private Sub cmdSendEmail_Approval_Click()

'LOOP STATEMENT

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM qryEmail_Approval_ALL")
    
Dim MyTrackingTable As Recordset
Set MyTrackingTable = CurrentDb.OpenRecordset("tblTerminationData_ActionsCompleted")

'Check to see if the recordset actually contains rows
If Not (rs.EOF And rs.BOF) Then
    rs.MoveFirst 'Unnecessary in this case, but still a good habit
    Do Until rs.EOF = True
    
'LOOPING ACTION - SEND EMAIL
         Dim strEmail, strBody As String
         Dim objOutlook As Outlook.Application
         Dim objEmail As Outlook.MailItem
    

        
        '**creates an instance of Outlook
        Set objOutlook = CreateObject("Outlook.application")
        Set objEmail = objOutlook.CreateItem(olMailItem)
        
        '**************************************************************
        '*create string with email address
        
        strID = SelectedTermination
        strEmail = strTo
        strBody = strConsolidatedBody
        
        '***creates and sends email
    With objEmail
            .To = strTo
            .CC = strCC
            .Subject = strSubject
            .HTMLBody = strConsolidatedBody
           ' .Display
           .Send
    End With

'Add record of send to Actions Compelted table
     MyTrackingTable.AddNew
     MyTrackingTable("intTerminationID") = strID
     MyTrackingTable("intActionID") = 1
     MyTrackingTable("dtmActionPerformed") = Now()
     MyTrackingTable.Update

'Move to the next record.
    rs.MoveNext
    
Loop

Else
    MsgBox "There are no records in the recordset."
End If

MsgBox "All email messages have been sent."

rs.Close 'Close the recordset
Set rs = Nothing 'Clean up
    
End Sub

 

[SkipVought]

On May 26 I advised you that the Outlook Set statements belong “BEFORE the loop” as well as your declarations.

You have ignored that advise and have suffered the consequence, it seems.

Link to FAQ: How to use the Watch Window as a Power Programming Tool

https://www.tek-tips.com/faqs.cfm?fid=4594

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Denae]

@SkipVought - I tried your suggestion and it broke the code even further, which is why I reverted back to to the partially working code. I do sincerely appreciate your help! I am very much a novice with VBA.

However I found a solution: I don't know why but changing the code from rs.XX to recordset.XX fixed the problem. Here is my working code for anyone who is interested:

Private Sub cmdSendEmail_Approval_Click()

'LOOP STATEMENT

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM qryEmail_Approval_ALL")
    
Dim MyTrackingTable As Recordset
Set MyTrackingTable = CurrentDb.OpenRecordset("tblTerminationData_ActionsCompleted")

'Check to see if the recordset actually contains rows
If Not (Recordset.EOF And Recordset.BOF) Then
Recordset.MoveFirst
'rs.MoveFirst 'Unnecessary in this case, but still a good habit
Do Until Recordset.EOF = True
    
'LOOPING ACTION - SEND EMAIL
         Dim strEmail, strBody As String
         Dim objOutlook As Outlook.Application
         Dim objEmail As Outlook.MailItem
    

        
        '**creates an instance of Outlook
        Set objOutlook = CreateObject("Outlook.application")
        Set objEmail = objOutlook.CreateItem(olMailItem)
        
        '**************************************************************
        '*create string with email address
        
        strID = SelectedTermination
        strEmail = strTo
        strBody = strConsolidatedBody
        
        '***creates and sends email
    With objEmail
            .To = strTo
            .CC = strCC
            .Subject = strSubject
            .HTMLBody = strConsolidatedBody
           ' .Display
           .Send
    End With

'Add record of send to Actions Compelted table
     MyTrackingTable.AddNew
     MyTrackingTable("intTerminationID") = strID
     MyTrackingTable("intActionID") = 1
     MyTrackingTable("dtmActionPerformed") = Now()
     MyTrackingTable.Update

'Move to the next record.
    Recordset.MoveNext
    
Loop

Else
    MsgBox "There are no records in the recordset."
End If

MsgBox "All email messages have been sent."

rs.Close 'Close the recordset
Set rst = Nothing 'Clean up
    
End Sub