Code sends duplicate emails

[AThom10731]

On form open I have code that I want to send a report as an email attachment each time the form is opened. The below code runs correctly and builds the email and attachment only it sends duplicate copy of the email each time I run it.
Please help!!!

Ann

Private Sub Form_Load()
Dim outputFName As String
Dim the_date As String
the_date = Format(Date, "mm-dd-yy")
outputFName = "\\server-01\reports\Reg1_ATO_Tracker" & the_date & ".pdf"
DoCmd.OutputTo acOutputReport, "Reg1_ATO Report by Facility", acFormatPDF, outputFName, False, , , acExportQualityPrint
Call SendMessage(0, outputFName)
DoCmd.Quit
End Sub
Sub SendMessage(DisplayMsg As Boolean, Optional AttachmentPath)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim crlf As String
Let crlf = "Chr$(10) + Chr$(32) ' carriage return and line feed"
Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
Set objOutlookRecip = .Recipients.Add("yourname@yourprovider.com")
objOutlookRecip.Type = olTo
Set objOutlookRecip = .Recipients.Add("ccname@yourprovider.com ")
objOutlookRecip.Type = olCC
.Subject = "This is an Automation test with Microsoft Outlook"
.Body = "The attached report is a listing of potential plans requiring attention as they have expired or will be expiring in the near future." & vbCrLf & vbCrLf & "SSP Database Administrator" & vbCrLf & vbCrLf
.Importance = olImportanceHigh 'High importance
' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next
.Save
End With
objOutlookMsg.Send
objOutlook.Quit
Set objOutlook = Nothing
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Sub

 

[vbajock]

I don't see anything in your code that would do it.

 

[AThom10731]

I looked at my emails again and it appears as though the report is running twice. They have different time stamps in the Report headers.

What I have is a task that I have scheduled on Mondays at 0745.
It

1) opens up MS Access
2) opens up database
3) opens a form
4) quits Access.

The form's On Load property contains [Event Procedure] and no other events.

The code I posted at the beginning of the thread is Private Sub Form_Load().

I so very much appreciate your post and assistance.

 

[dhookom]

I would consider creating a log table. Store the fact that you sent the email on the date. Check the table prior to sending again.

Duane
Hook'D on Access
MS Access MVP

 

[vbajock]

Do you know how to put a Stop or control break in your code so you can step thru it?

 

[vbajock]

Also, take Duane's advice, you just need to open a recordset and append a record every time the email goes, it should have these columns: name of the email (I usually use the subject line), TO, CC and AlertSent (YesNo) and AlertDateTime (Long Date) and ReturnCode(Text 255) Default "0" . Add a record right after it hits the .send command if it does so with out error. You should also add an error handler to your code, that way you can append a record to the table setting the Return Code to the Err and Error$ property if it fails to go, and set the AlertSent to false and AlertDateTime to Null. Your code would look like this:

Function SendMessage(DisplayMsg As Boolean, Optional AttachmentPath) as Boolean <-change to function
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim crlf As String
Dim retval as Boolean <----- Add a return value for your function to be set by success of email transmission
dim dDateSent as date <----- add a date variable to store send date
on error goto err_h

Dim rs as ADODB.recordset < set up a log table
Set rs=new ADODB.recordset
rs.Open "tblEmailLog", CurrentProject.Connection, adOpenDynamic, adLockOptimistic, adCmdTable
retval =true <---- initialize return value to true
rs.addnew <-------APPEND A LOG RECORD

Let crlf = "Chr$(10) + Chr$(32) ' carriage return and line feed"
Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
Set objOutlookRecip = .Recipients.Add("yourname@yourprovider.com")
objOutlookRecip.Type = olTo
Set objOutlookRecip = .Recipients.Add("ccname@yourprovider.com ")
objOutlookRecip.Type = olCC
.Subject = "This is an Automation test with Microsoft Outlook"
.Body = "The attached report is a listing of potential plans requiring attention as they have expired or will be expiring in the near future." & vbCrLf & vbCrLf & "SSP Database Administrator" & vbCrLf & vbCrLf
.Importance = olImportanceHigh 'High importance
' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next
.Save
End With
objOutlookMsg.Send



'*****
Exit_h:
'*****
rs!AlertDateTime=Now()
rs!AlertSent=Retval
rs.update

SendMessage=retval
objOutlook.Quit
Set objOutlook = Nothing
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
Exit Function

'*****
Err_H:
'*****
retval=false <---email transmission has failed
rs!AlertSent=false <------ flag alert
rs!ReturnCode=Str$(err)&" "&Error$
Resume Exit_h



End Function

then your calling sub looks like this

Private Sub Form_Load()
STOP <---- Put a stop statement right here to trouble shoot your code, hit the F8 to execute it line by line once it hits the stop statement

Dim outputFName As String
Dim the_date As String
the_date = Format(Date, "mm-dd-yy")
outputFName = "\\server-01\reports\Reg1_ATO_Tracker" & the_date & ".pdf"
DoCmd.OutputTo acOutputReport, "Reg1_ATO Report by Facility", acFormatPDF, outputFName, False, , , acExportQualityPrint

if SendMessage(0, outputFName)=false then <-- return value controls what happens
msgbox "Something went wrong"
endif

DoCmd.Quit
End Sub


My guess is your problem has something to do with putting it in the Load event, something that is not common practice is there some other way you can trigger it?

 

[AThom10731]

Thanks, I will give that a try. Yes, I had thought the Load event may be causing the problem as well. Not sure about an alternative. Thanks again.

 

[strongm]

That SendMessage code is pretty much a lift from Microsoft's "Using Automation to Send a Microsoft Outlook Message" KB article, which I'm fairly certain only sends one copy. So it's got to be elsewhere in your code that the problem occurs.