Code sending two emails and shouldn't be...

[carl6885]

Hi, me again!

I have the following code that pulls the logging users area, team, manager and email so that it can notify them of the error that has been logged.

It all works, which is good however it is sending the email twice!!

I have tested the SQL in Query Design and it only pulls one row of date (which is expected in this sql statement) however its sending the email twice.

Code as follows:

'Sub routine that sends an email to the team causing manager(s) when a breach is logged.
Public Sub SendBreachEmail()
On Error GoTo ErrSendBreachEmail:
Dim LoggedArea1 As String
Dim LoggedArea2 As String
Dim LoggedTeam1 As String
Dim LoggedTeam2 As String

LoggedArea1 = Form_frmLogBreach.cboAreaCaused1
LoggedArea2 = Nz(Form_frmLogBreach.cboAreaCaused2, "")
LoggedTeam1 = Form_frmLogBreach.cboTeamCaused1
LoggedTeam2 = Nz(Form_frmLogBreach.cboTeamCaused2, "")

Dim sql As String
Dim rec As dao.Recordset

'Assigns the right SELECT statement to sql depending on the number of team(s)/area(s) causing.
If IsNull(Form_frmLogBreach.cboAreaCaused2) Then
sql = "SELECT tblUsers.FullName, tblUsers.Email FROM tblUsers WHERE (((tblUsers.UserGrade)='Manager') AND ((tblUsers.Department)='" & LoggedArea1 & "') AND ((tblUsers.Team)='" & LoggedTeam1 & "'));"
Else
sql = "SELECT tblUsers.FullName, tblUsers.Email FROM tblUsers WHERE (((tblUsers.UserGrade)='Manager') AND ((tblUsers.Department)='" & LoggedArea1 & "') AND ((tblUsers.Team)='" & LoggedTeam1 & "')) OR (((tblUsers.Department)='" & LoggedArea2 & "') AND ((tblUsers.Team)='" & LoggedTeam2 & "'));"

End If

Set rec = CurrentDb.OpenRecordset(sql, dbOpenDynaset)
'rec.MoveFirst
'Loops through each email address returned, sending an email to each.
Do Until rec.EOF


'MsgBox (rec!Email & " " & rec!FullName)
'Sends the actual email.
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = rec!Email
.From = "Error Reporting Tool"
.Subject = "AUTOMATED MESSAGE: A breach has been logged against your team."
.Body = "Dear " & rec!FullName & vbCrLf & vbCrLf & "An error has been logged against your team. Here is the summary:" & vbCrLf & vbCrLf & Form_frmLogBreach.txtTitle & vbCrLf & vbCrLf & "Regards" & vbCrLf & vbCrLf & "Error Reporting Tool"
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing

rec.MoveNext
Loop
rec.Close
Set rec = Nothing

Exit Sub

ErrSendBreachEmail:
MsgBox ("An error occurred whilst sending the breach notification email: " & Err.Description)
mdlDatabaseActivity.ErrorID = Err.Number
mdlDatabaseActivity.ErrorDesc = Err.Description
mdlDatabaseActivity.CentralErrorHandler "mdlDatabaseActivity", "SendBreachEmail"

Resume Next

End Sub

Can anyone spot my mistake?

Thanks in advance.

Carl

 

[spikepl]

Plaase paste your code in code tags. Go advanced, select the code and press "#"

 

[jdraw]

What have you done to correct the "error"? Have you tried stepping through the code line by line (F8)? Do you use .Display instead of .Send, to confirm what will be sent?

Have you tried a few Debug.print statements and one or 2 records from your recordset to see what and where things are "off track"?

Just some debugging thoughts to correct things.

 

[spikepl]

jdraw is right. Follow "Debugging tips" here: http://www.access-programmers.co.uk/forums/showthread.php?t=149429

 

[carl6885]

Public Sub SendBreachEmail()
On Error GoTo ErrSendBreachEmail:
    Dim LoggedArea1 As String
    Dim LoggedArea2 As String
    Dim LoggedTeam1 As String
    Dim LoggedTeam2 As String
    
    LoggedArea1 = Form_frmLogBreach.cboAreaCaused1
    LoggedArea2 = Nz(Form_frmLogBreach.cboAreaCaused2, "")
    LoggedTeam1 = Form_frmLogBreach.cboTeamCaused1
    LoggedTeam2 = Nz(Form_frmLogBreach.cboTeamCaused2, "")
    
    Dim sql As String
    Dim rec As dao.Recordset
 
    'Assigns the right SELECT statement to sql depending on the number of team(s)/area(s) causing.
    If IsNull(Form_frmLogBreach.cboAreaCaused2) Then
        sql = "SELECT tblUsers.FullName, tblUsers.Email FROM tblUsers WHERE (((tblUsers.UserGrade)='Manager') AND ((tblUsers.Department)='" & LoggedArea1 & "') AND ((tblUsers.Team)='" & LoggedTeam1 & "'));"
    Else
        sql = "SELECT tblUsers.FullName, tblUsers.Email FROM tblUsers WHERE (((tblUsers.UserGrade)='Manager') AND ((tblUsers.Department)='" & LoggedArea1 & "') AND ((tblUsers.Team)='" & LoggedTeam1 & "')) OR (((tblUsers.Department)='" & LoggedArea2 & "') AND ((tblUsers.Team)='" & LoggedTeam2 & "'));"
    
    End If

    Set rec = CurrentDb.OpenRecordset(sql, dbOpenDynaset)
    'rec.MoveFirst
    'Loops through each email address returned, sending an email to each.
    Do Until rec.EOF
    
    
        'MsgBox (rec!Email & " " & rec!FullName)
        'Sends the actual email.
            Dim OutApp As Object
            Dim OutMail As Object
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
               With OutMail
                    .To = rec!Email
                    .From = "Error Reporting Tool"
                    .Subject = "AUTOMATED MESSAGE: A breach has been logged against your team."
                    .Body = "Dear " & rec!FullName & vbCrLf & vbCrLf & "An error has been logged against your team. Here is the summary:" & vbCrLf & vbCrLf & Form_frmLogBreach.txtTitle & vbCrLf & vbCrLf & "Regards" & vbCrLf & vbCrLf & "Error Reporting Tool"
                    .Send
                End With
            On Error GoTo 0
            Set OutMail = Nothing
            Set OutApp = Nothing
            
            rec.MoveNext
    Loop
    rec.Close
    Set rec = Nothing
    
    Exit Sub
    
ErrSendBreachEmail:
    MsgBox ("An error occurred whilst sending the breach notification email: " & Err.Description)
    mdlDatabaseActivity.ErrorID = Err.Number
    mdlDatabaseActivity.ErrorDesc = Err.Description
    mdlDatabaseActivity.CentralErrorHandler "mdlDatabaseActivity", "SendBreachEmail"
    
    Resume Next
    
End Sub

 

[carl6885]

Hi

Code in tags above.

I have tried a number of debugging techniques, I have copied and pasted the sql into Qery Design which gives only one record, i have inserted a breakpoint on the function then stepped through - it only loops through onces as it should however it is still sending two emails....

 

[spikepl]

So maybe your email adress field contains two adresseses? Or the sub is called twice, or your email appears in two rows of the record set?

Besides, having all the outlook object creation and destruction inside of the loop is a bit pointless. only handling Outmail should be insde the loop, the rest only needs to run once.

 

[carl6885]

Thanks for the pointer - I have moved the creation and descruction out of the loop.

It would appear that my outMail.From tag was causing it to send twice moving the destruction etc highlighted it as unsuported.