Question Access 2010 email records in body

[Jonno]

Hi

Has anyone experienced the following problem - I've set up a piece of VBA code to loop through and email various recipients data, in the form of records within the email body. This works fine, but occasionally produces an error whereby the email output body lines are duplicated spuriously. This only seems to happen when running a large number of email loops.

The data source for the email body content is a table, which for each 'loop' is refreshed with new data by 1) deleting records from that table, and then 2) appending data to the table.

The portion of code for the loop & email:

Do

'Build outputbodytext
DoCmd.OpenQuery ("EmailQ2")
DoCmd.OpenQuery ("EmailQ1")
'set up email
Set rec2 = CurrentDb.OpenRecordset("outputbodytext")
strSendTo = rec2("Email")
strTo = rec2("Email")
strcc = ""
Set olApp = CreateObject("Outlook.application")
Set olItem = olApp.createitem(olMailTem)
olItem.Display
olItem.To = strTo
olItem.cc = strcc
olItem.Body = "Remittance Advice - details as follows: "
olItem.Subject = "Remittance Advice"


Set rec = CurrentDb.OpenRecordset("OutputBodyText")
If Not (rec.BOF And rec.EOF) Then
rec.MoveLast
rec.MoveFirst
intCount = rec.RecordCount
'loop lines within table
For intLoop = 1 To intCount
olItem.Body = olItem.Body & rec("txt") & Chr(1)
rec.MoveNext
Next intLoop
End If
With olItem
.send

End With
Me.currentkey = Me.currentkey + 1
Loop Until Me.currentkey = Me.Maxrecord + 1
MsgBox "Completed"
Set olApp = Nothing
Set olItem = Nothing


Best regards

 

[DavidAtWork]

There are a few things that don't look right to me
strSendTo = rec2("Email")
strTo = rec2("Email")
should be:
strSendTo = rec2.Fields("Email")
strTo = rec2.Fields("Email")

olItem.Body = olItem.Body & rec("txt") & Chr(1)
should be:
olItem.Body = olItem.Body & rec.Fields("txt") & Chr(1)

If I'm understanding your intention correctly there appears to be a logic error in your loop set up, you have opened the OUTER loop to establish the email recipient etc, but you don't have an INNER loop to collect the lines of text for the email body.
I don't know what this "outputbodytext" consists of, if it's a table I would have expected something like this

Dim recipSQLStr, bodySQLStr as String
 
recipSQLStr = "SELECT email FROM outputbodytext GROUP BY email"
Set rec2 = CurrentDb.OpenRecordset(recipSQLStr)
Do While Not rec2.EOF
    strTo = rec2.Fields("Email")
    strcc = ""
    Set olApp = CreateObject("Outlook.application")
    Set olItem = olApp.createitem(olMailTem)
    olItem.Display
    olItem.To = strTo
    olItem.cc = strcc
    olItem.Subject = "Remittance Advice"
    bodySQLStr = "SELECT txt FROM outputbodytext WHERE email = '" & strTo & "'"
    Set rec = CurrentDb.OpenRecordset(bodySQLStr)
    rec.MoveLast
    rec.MoveFirst
    If rec.RecordCount > 0 Then
        olItem.Body = "Remittance Advice - details as follows: "
        Do While Not rec.EOF
            olItem.Body = olItem.Body & Chr(1) & rec.Fields("txt") 
            rec.Movenext
        Loop
        Else    
            olItem.Body = "Remittance Advice - No other details"
 
    End If
    With olItem
        .send
    End With
    Set rec = Nothing
    rec2.Movenext
Loop
Set rec2 = Nothing

David

 

[spikepl]

When pasting code, use the code tags . Go Advanced->select your code -> Press #
When posting code, do not post exerpts but the entire code, incl subroutine headres/declarations.

What you posted here is not the code that creates the problem. Your method of making/deleteing table is a bit suspect, why not use a query? Deleting records in loops can easily be messed up. Show the code.

 

[Jonno]

Hi there

Thanks for the info - will revisit the code. But I agree that the code isn't causing the issue - I suspect the problem is with how Outlook is handling large quantities of email at the same time - when I run this on an email by email basis ( omitting the .send command) the problem disappears.