I have multi functional Access DB that generates a series of spreadsheet, one per cutomer. I have then built a module that selects these spreadsheets one by one and emails them to a selected email address stored in the DB. Currently it generates 413 spreadsheets and then when I go to email them something weird happens. The code cycles once, sending 413 emails, and then randomly it sometimes cycles a second time and send all 413 again. It appears to be that if I open the db from scratch it sends 413, but if the db is open and emails have previously been sent without closing it send 826. I presume a variable is being held somewhere, but I cannot see where or why.

The code is below, rs3 selects the path for the outlook templates and where the spreadsheets are stored. Then rs1 selects the 413 record (filename, email addresses, etc.), this rs is looped. rs2 selects the total value per invoice, invoice number and currency per row. There are a couple of loops prior to mail send that replaces tags in the mail template with these values. Does anyone have any idea whe i’m missing?

Sub send_spreadsheet()


Dim rs1, rs2, rs3 As Recordset
Dim mailto, mailfrom, mailcc, subject, template, filename, poct As String
Dim OutApp As Outlook.Application
Dim FileInFromFolder As Object
Dim Mail_Object, Mail_Single As Variant
Dim sSource As String
Dim I As Long
Dim OutMail As Outlook.MailItem
Dim olinsp As Object
Dim oRng As Object
Dim wdDoc As Object
Dim valu, po As Long


Set rs3 = CurrentDb.OpenRecordset("SELECT defaults.excel_results, defaults.[email _templates] FROM defaults;")
Let tmplpath = rs3![email _templates]
Let filepath = rs3!excel_results

Set rs1 = CurrentDb.OpenRecordset("SELECT tmp_data_for_report.Template, tmp_data_for_report.filename, tmp_data_for_report.[mail subject], tmp_data_for_report.PO_Contact, " & _
"tmp_data_for_report.[Customer_POC-email], tmp_data_for_report.AM_EMAIL FROM tmp_data_for_report GROUP BY tmp_data_for_report.Template, tmp_data_for_report.filename, " & _
"tmp_data_for_report.[mail subject], tmp_data_for_report.PO_Contact, tmp_data_for_report.[Customer_POC-email], tmp_data_for_report.AM_EMAIL;")

If rs1.RecordCount > 0 Then
MsgBox rs1.RecordCount


 rs1.MoveFirst
 Do While Not rs1.EOF
 Let filename = rs1!filename
Let template = tmplpath & rs1!template & "_PO.oft"
Let subject = rs1![Mail Subject]
Let mailto = rs1!.PO_Contact
Let mailcc = rs1![Customer_POC-email] & ";" & rs1!AM_EMAIL

Set rs2 = CurrentDb.OpenRecordset("SELECT tmp_data_for_report.filename, tmp_data_for_report.PONUMBER, tmp_data_for_report.CURRENCYCODE, Sum(tmp_data_for_report.TOTAL) AS " & _
"SumOfTOTAL FROM tmp_data_for_report GROUP BY tmp_data_for_report.filename, tmp_data_for_report.PONUMBER, tmp_data_for_report.CURRENCYCODE " & _
"HAVING (((tmp_data_for_report.filename)='" & filename & "'));")
 Let valu = rs2!SumOfTOTAL
 Let curr = rs2!CURRENCYCODE
 Let po = rs2.RecordCount
Let filename = filepath & filename

    Set OutApp = CreateObject("Outlook.Application")
 Set OutMail = OutApp.CreateItemFromTemplate(template)
 OutMail.Display
'
' CYCLE THROUGH AVAILABLE MAIL ACCOUNTS (PERSONAL AND PROCESS TO IDENTIFY CORRECT SEQUENCE NUMBER
'
    For I = 1 To OutApp.Session.Accounts.Count
    If OutApp.Session.Accounts.Item(I) = "[email protected]" Then Let ACCNO = I
    Next I
'
'SEND EMAIL BASED UPON sp data
Set Mail_Object = CreateObject("Outlook.Application")
'Set OutMail = OutApp.CreateItem(olMailItem)
If ACCNO = "" Then Let ACCNO = 1
With OutMail
.SendUsingAccount = OutApp.Session.Accounts.Item(ACCNO)
.subject = subject
.To = mailto
.CC = mailcc
.BCC = ""
'.Body = mb
.Display
.Attachments.Add filename

Set olinsp = .GetInspector
Set wdDoc = olinsp.WordEditor
Set oRng = wdDoc.Range
With oRng.Find
Do While .Execute(FindText:="XVALX")
oRng.Text = valu
Exit Do
Loop
End With
Set oRng = Nothing
Set oRng = wdDoc.Range

With oRng.Find
Do While .Execute(FindText:="XCURRX")
oRng.Text = curr
Exit Do
Loop
End With
Set oRng = Nothing
Set oRng = wdDoc.Range
If po = 1 Then Let poct = "1 PO was "
If po > 1 Then Let poct = po & " POs were"

With oRng.Find
Do While .Execute(FindText:="XPOX")
oRng.Text = poct
Exit Do
Loop
End With

.Send
End With

    Set OutMail = Nothing
    Set OutApp = Nothing
   rs1.MoveNext
Loop

End If
Set rs1 = Nothing
Set rs2 = Nothing
End Sub