Outlook .send errors in one place but works fine elsewhere

[Robyn_P]

Okay, I'm going mad. Can anyone see any differences between these two pieces of code because I sure as **** can't. The first is in a form's onload even and works perfectly. The second is behind a command button and errors everytime with a "Run-time error '287' Application-defined or object-defined error'. Changing .Send to .Display in the second lot of code works fine, but obviously doesn't automatically send the email.



Can anyone think of a solution or work around to get the second lot of code actually sending emails?

I've texted and it's not a problem with the html body text which I have removed for brevity reasons.

Dim oApp As Outlook.Application
Dim oMail As MailItem
Dim Plan As DAO.Recordset
Dim oText As String
Dim ccUsers As DAO.Recordset
Dim ccList As String




    
    '******************************************************************************
    ' Put in code to check for the need to send IPS reminder emails and if
    ' found, send these emails.  We send reminders after 2 days, 5 days and 10 days
    '*******************************************************************************
    ' The following code is limited to certain users as it hijacks the users email and we are not sure
    ' how people will feel about this.
    ' Look up the users IPS status from tblUsers.  This is just people who have given permission for their email to be used
    ' for these automated emails.
    If DLookup("[isIPSuser]", "tblUsers", "[ID]=" & Me.lblUserID.Caption) Then
    
        ' Get the full list of outstanding IPS reviews
        Set IPSreviews = CurrentDb.OpenRecordset("SELECT * FROM tblIPScomments WHERE isnull([CompletedDate]) And [noComments] = False")
        Set oApp = CreateObject("Outlook.Application")
        If Not (IPSreviews.BOF And IPSreviews.EOF) Then
            IPSreviews.MoveFirst
        
            ' Loop through and process each review request in turn
            Do Until IPSreviews.EOF
            
                ' Set sendEmail to false
                sendEmail = False
                
                ' Find out whether we need to send a reminder email.
                ' If a reminder has been
                ' Also find out which reminder emails we have already sent
                If IsNull(IPSreviews("ReminderSent")) Then
                    ' No reminder email sent
                    elapsedDays = fWorkingDays(IPSreviews("DueDate"), Date) + 1
                Else
                    elapsedDays = fWorkingDays(IPSreviews("ReminderSent"), Date) + 1
                End If
                
               If elapsedDays > 1 Then
                
                    On Error Resume Next
                    
                    ' Set up the initial email text.
                    ' We do this everytime even if we don't need to send a reminder because it is simpler and takes little processing time.
                    ' get the details of the related plan
                    Set Plan = CurrentDb.OpenRecordset("SELECT * FROM tblIPS WHERE [ID]=" & IPSreviews("Plan"))
                    ' EMAIL TEXT
                    OtEXT = "Some text"


                    'Send the email
                    Set oMail = oApp.CreateItem(olMailItem)
                                  
                    ' Set up the cc list for the emails.
                    ' Certain users are specified in the database as being cc'd on all reminder emails
                    ccList = ""
                    Set ccUsers = CurrentDb.OpenRecordset("SELECT * FROM tblusers WHERE [ccIPSreminders]=True")
                    If Not (ccUsers.EOF And ccUsers.BOF) Then
                        Do Until ccUsers.EOF
                            ccUsers.MoveLast
                            ccList = ccList & ccUsers("email") & ";"
                            ccUsers.MoveNext
                        Loop
                        ccList = Left(ccList, Len(ccList) - 1)
                    End If
                    
            
                    With oMail
                        .To = DLookup("[email]", "tblUsers", "[ID]=" & IPSreviews("MainReviewer"))
                        If IsNull(IPSreviews("BackupReviewer")) Then
                            .cc = ccList
                        Else
                            .cc = DLookup("[email]", "tblUsers", "[ID]=" & IPSreviews("BackupReviewer")) & "; " & ccList
                        End If
                        .BCC = ""
                        If elapsedDays = 0 Then
                            .subject = "The review of IPS plan " & Plan("WorkPlan") & " is now due"
                        Else
                            .subject = "The review of IPS Plan " & Plan("WorkPlan") & " is now overdue by " & elapsedDays & " day(s)."
                        End If
                        If elapsedDays > 0 Then .Importance = olImportanceHigh
                        .HTMLBody = oText
                        .Send
                    End With
                    On Error GoTo 0
                    
                    ' Set the reminder sent field
                    IPSreviews.Edit
                    IPSreviews("ReminderSent") = Now
                    IPSreviews.Update
                End If
                
                IPSreviews.MoveNext
            Loop
        End If
        
        Set oApp = Nothing
        Set IPSreviews = Nothing
        Set Plan = Nothing
    End If
End Sub

Private Sub cmdEmailReviewers_Click()


    Dim reviewList As DAO.Recordset
    Dim Plan As DAO.Recordset
    Dim oApp As Outlook.Application
    Dim oMail As MailItem
    
    ' First check that all the reviewers have been specified.  That is that there
    ' are no blank gaps in the main reviewer column
    Set reviewList = CurrentDb.OpenRecordset("SELECT * FROM tblIPScomments WHERE [Plan]=" & Me.txtHiddenID & " AND isnull([MainReviewer])")
    ' If all reviewers have been specified this should return no records
    If Not (reviewList.BOF And reviewList.EOF) Then
        text = "You must specify at least a primary reviewer for each stage of the review loop.  "
        text = text & "Specification of a backup reviewer is optional.  Please do this now and try again."
        MsgBox text, vbOKOnly, "Missing Info"
        Exit Sub
    End If
    
    ' Reset the reviwelist to pick up all reviewers for this plan
    ' At this stage we shouldn't have already sent any emails, but to be safe that we do not
    ' accidently allow people to spam reviewers with messages, also ensure that the email sent date is blank
    ' We set the EmailSent date when we first send out request for review emails.
    ' Not we also need to get the plan details to populate the email with useful information
    Set reviewList = CurrentDb.OpenRecordset("SELECT * FROM tblIPScomments WHERE [Plan]=" & Me.txtHiddenID & " AND isnull([EmailSent])")
    Set Plan = CurrentDb.OpenRecordset("SELECT * FROM tblIPS WHERE [ID]=" & Me.txtHiddenID)
    Set oApp = CreateObject("Outlook.Application")
            
    ' Loop through the recordset and email the reviewers about their responsibilities
    If reviewList.BOF And reviewList.EOF Then
        ' Request for review emails already sent, inform the user and exit
        text = "Request for review emails have already been sent for this plan."
        MsgBox text, vbOKOnly, "Duplicated Action"
        Exit Sub
    End If
    reviewList.MoveFirst
    Do Until reviewList.EOF
    
        ' First process any Main reviewers.  We have already checked that these are always specified
        ' EMAIL TEXT
        
        ' Line 1:  Warning that this is an automated email and not to reply to it.  This is always the same
        text = some sample text
        
        ' END EMAIL TEXT
        
        'Send the email
        Set oMail = oApp.CreateItem(olMailItem)


        'On Error Resume Next
        With oMail
            .To = DLookup("[email]", "tblUsers", "[ID]=" & reviewList("MainReviewer"))
            If Not IsNull(reviewList("BackupReviewer")) Then
                .cc = DLookup("[email]", "tblUsers", "[ID]=" & reviewList("BackupReviewer"))
            Else
                .cc = ""
            End If
            .BCC = ""
            .subject = "Please Review IPS Plan " & Plan("WorkPlan") & " by " & reviewList("DueDate")
            ' If High Urgency is set, send as important
            If Me.chkUrgency Then .Importance = olImportanceHigh
            .HTMLBody = text
            .Send   ' <-ERRORS HERE
        End With
        On Error GoTo 0


        ' Mark the email as having been sent
        reviewList.Edit
        reviewList("EmailSent") = Now
        reviewList.Update
                
        ' Move to the next reviewer
        reviewList.MoveNext
        
    Loop


    Set oMail = Nothing
    Set oApp = Nothing

[Minty]

Is there actually a sender address present ?

Try a
Debug.print DLookup("[email]", "tblUsers", "[ID]=" & reviewList("MainReviewer"))

Before you get to the Outlook object.

If it isn't, this is why it's a really good idea to assign all the automation items to a variable first.
Trying to assign a null value to strEmailTo would raise meaningful error before you start with the outlook object.

[Robyn_P]

Thanks for the suggestion. I did think that the to and cc lists are specifically assigned to strong variables in the first and not in the second. I'll try assigning them to defined strings as well as the debug suggestion (but when the email displays it's populated). I'll let you know how it goes.

[Robyn_P]

Sadly that makes new difference. We do have new security export control ratings on our emails now (this only started happening when I switched to win10), but that's the same for the code that does work.

I need to get this fix out soon, so if we can't think of anything I'm just going to use .display and people can manually hit send buttons. It's not a task that is done all the time, they'll cope but it's perplexing me.

[Minty]

Have you got Option Explicit at the top of all you code modules, and what happens if you compile it?
I ask because this line

text = some sample text

Should through up an error.

And then

.HTMLBody = text

Would possibly be your problem?
You use oText in the previous example, and set it to a string.

[Robyn_P]

Oh that's not actually the code. The body text section of the email is very long so I cut it out when pasting the code here. I did try explicitly defining text as a string though and it made no difference. I also changed text to oText throughout and again this made no difference it still errors. Thanks for the suggestion though

[Minty]

Okay it really helps if you paste the actual code being used, you are assuming that it is the same, but we can't see it exactly as used.

For the sake of testing replace your massive text strings with "Test text", and then re-run in your complete code.
If you still get the same error please post back with the exact code you are actually using.

If the problem goes away then you know it's something in your text.

[Robyn_P]

To quote from my original post "I've texted and it's not a problem with the html body text which I have removed for brevity reasons.". I already did that.

If you're interested in the full text it's here:

Private Sub cmdEmailReviewers_Click()


    Dim reviewList As DAO.Recordset
    Dim Plan As DAO.Recordset
    Dim oApp As Outlook.Application
    Dim oMail As MailItem
    Dim toList As String
    Dim ccList As String
    Dim oText As String
    
    ' First check that all the reviewers have been specified.  That is that there
    ' are no blank gaps in the main reviewer column
    Set reviewList = CurrentDb.OpenRecordset("SELECT * FROM tblIPScomments WHERE [Plan]=" & Me.txtHiddenID & " AND isnull([MainReviewer])")
    ' If all reviewers have been specified this should return no records
    If Not (reviewList.BOF And reviewList.EOF) Then
        oText = "You must specify at least a primary reviewer for each stage of the review loop.  "
        oText = oText & "Specification of a backup reviewer is optional.  Please do this now and try again."
        MsgBox oText, vbOKOnly, "Missing Info"
        Exit Sub
    End If
    
    ' Reset the reviwelist to pick up all reviewers for this plan
    ' At this stage we shouldn't have already sent any emails, but to be safe that we do not
    ' accidently allow people to spam reviewers with messages, also ensure that the email sent date is blank
    ' We set the EmailSent date when we first send out request for review emails.
    ' Not we also need to get the plan details to populate the email with useful information
    Set reviewList = CurrentDb.OpenRecordset("SELECT * FROM tblIPScomments WHERE [Plan]=" & Me.txtHiddenID & " AND isnull([EmailSent])")
    Set Plan = CurrentDb.OpenRecordset("SELECT * FROM tblIPS WHERE [ID]=" & Me.txtHiddenID)
    Set oApp = CreateObject("Outlook.Application")
            
    ' Loop through the recordset and email the reviewers about their responsibilities
    If reviewList.BOF And reviewList.EOF Then
        ' Request for review emails already sent, inform the user and exit
        oText = "Request for review emails have already been sent for this plan."
        MsgBox oText, vbOKOnly, "Duplicated Action"
        Exit Sub
    End If
    reviewList.MoveFirst
    Do Until reviewList.EOF
    
        ' First process any Main reviewers.  We have already checked that these are always specified
        ' EMAIL oText
  
        ' Line 1:  Warning that this is an automated email and not to reply to it.  This is always the same
        oText = "<font color='red'>NOTE: THIS IS AN AUTOMATED EMAIL FROM THE CONFIGURATION MANAGEMENT DATABASE.</font><br><br>"
            
        ' Line 2 - Opening
        oText = oText & "Dear " & DLookup("[FirstName]", "tblUsers", "[ID]=" & reviewList("MainReviewer")) & ",<br><br>"
        
        ' oText ongoing.  Explain the situation
        oText = oText & "A new IPS process plan is ready for review.  You have been specified as the primary " & reviewList("ReviewerType") & " reviewer for this plan.<br><br>"
        oText = oText & "Plan Details: <br>"
        oText = oText & "<ul><li>Plan Title: " & Plan("Title") & "</li>"
        oText = oText & "<li>Plan Number: " & Plan("WorkPlan") & "</li>"
        oText = oText & "<li>Review Due Date: " & reviewList("DueDate") & "</li>"
        oText = oText & "<li>Plan Directory: <a href='" & Plan("Dir") & "'>Hyperlink to directory</a></li></ul><br>"
        oText = oText & "If the plan PDF is not in the directory, please contact the author, "
        oText = oText & DLookup("[FirstName]", "tblUsers", "[ID]=" & Plan("PlanOwner")) & " "
        oText = oText & DLookup("[LastName]", "tblUsers", "[ID]=" & Plan("PlanOwner")) & ", to obtain a copy.<br><br>"
        
        ' Explain who the backup reviewer is if there is one.
        If Not IsNull(reviewList("BackupReviewer")) Then
            oText = oText & "If you are unable to complete this review in the allotted time, the backup reviewer is specified as "
            oText = oText & DLookup("[FirstName]", "tblUsers", "[ID]=" & reviewList("BackupReviewer")) & " "
            oText = oText & DLookup("[LastName]", "tblUsers", "[ID]=" & reviewList("BackupReviewer"))
            oText = oText & ".  Please contact them to ensure the review is completed.<br><br>"
        End If
        
        ' Tell the user what to do with their review comments
        oText = oText & "Once the review is complete, please "
        oText = oText & "log into the <a href='C:\ProgramData\Trusted VBA\ConfigurationManagementDatabase.accde'>Configuration Management Database</a> to mark your comments as complete and "
        oText = oText & "save your marked up PDFs in the directory above.<br><br>  "
        oText = oText & "You can mark comments as complete through the [Update IPS Work Order or Work Plan] option on the IPS Functionality tab of the dashboard.  "
        oText = oText & "Failure to do so will result in automatic reminder emails and potential delays to the project.<br><br>"
        
        ' Inform the person in cc that they are the backup reviewer
        oText = oText & "<font color='blue'>If you are in cc on this email then you have been specified as the backup reviewer. Please check if you are required with the primary reviewer</font><br><br>"
        
        ' Add any special notes if there are any
        If Not IsNull(Me.txtNotes) Then
            oText = oText & "<b>Special Notes</b><br>"
            oText = oText & "<font color='" & Me.cboColour & "'>" & Me.txtNotes & "</font><br><br>"
        End If
       
        ' Sign Off
        oText = oText & "Sent on behalf of " & DLookup("[FirstName]", "tblUsers", "[ID]=" & Plan("PlanOwner")) & " " & DLookup("[LastName]", "tblUsers", "[ID]=" & Plan("PlanOwner"))
        
        ' END EMAIL oText
        
        'Send the email
        Set oMail = oApp.CreateItem(olMailItem)


        toList = DLookup("[email]", "tblUsers", "[ID]=" & reviewList("MainReviewer"))
        If Not IsNull(reviewList("BackupReviewer")) Then
            ccList = DLookup("[email]", "tblUsers", "[ID]=" & reviewList("BackupReviewer"))
        Else
            ccList = ""
        End If
       
        'On Error Resume Next
        With oMail
            .To = toList
            .cc = ccList
            .BCC = ""
            .subject = "Please Review IPS Plan " & Plan("WorkPlan") & " by " & reviewList("DueDate")
            ' If High Urgency is set, send as important
            If Me.chkUrgency Then .Importance = olImportanceHigh
            .HTMLBody = oText
            .Display
        End With
        On Error GoTo 0


        ' Mark the email as having been sent
        reviewList.Edit
        reviewList("EmailSent") = Now
        reviewList.Update
                
        ' Move to the next reviewer
        reviewList.MoveNext
        
    Loop


    MsgBox "Please send the emails that have appeared on your screen.", vbOKOnly, "Manual action required"


    Set oMail = Nothing
    Set oApp = Nothing
    
     
     ' If there are updated notes since the plan was originally added, save these to the database now
     If Me.cmdEdit.Caption = "Save Notes" Then
        Set Plan = CurrentDb.OpenRecordset("SELECT * FROM tblIPS WHERE [ID]=" & Me.txtHiddenID)
        Plan.Edit
        Plan("Notes") = Me.txtNotes
        Plan.Update
        Plan.Close
        Set Plan = Nothing
        Me.cmdEdit.Caption = "Edit Notes"
     End If
     
     ' Inform the user that emails have been sent
     MsgBox "Review request emails sent for this plan.", vbOKOnly, "Complete"

[Minty]

The only thing I can think of is possibly adding

  Set oMail = Nothing

After you movenext to the next rs record.

By any chance is your testing only using one email for the first form Load event then trying the second one might mean you have a rogue Outlook.mail object item lurking open, that is preventing you doing other Outlook things.,

[Gicu]

Can you try the suggestion from this to add a loop before .Send;

https://stackoverflow.com/questions/...-vba-in-access

Cheers,