Send mail through Outlook - Error 287
<p>I am trying to loop through a set of worksheets, save each of them as a separate workbook, and then send them as attachment by mail.</p>

<p>However when running the below code, I end up with error 287 triggered by .Send. I have outlook open, so that is not the problem. If I change .Send to .Display, the mails are generated as drafts as displayed properly with the correct sheet attached.</p>

<pre><code>Sub SendWorksheetsByMail()
    Dim wb As Workbook
    Dim destinationWb As Workbook
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem

    Set wb = Workbooks("Test.xlsm")

    Application.EnableEvents = False
    Application.ScreenUpdating = False

    For Each ws In wb.Worksheets
        'Ignore Summary and Config
        If ws.Name &lt;&gt; "Summary" And ws.Name &lt;&gt; "Config" Then
            'On Error Resume Next
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(olMailItem)

            ws.Copy
            Set destinationWb = ActiveWorkbook
            destinationWb.SaveAs "C:\****************\" &amp; ws.Name &amp; ".xlsx", FileFormat:=51
            With OutMail
                .To = "*******************"
                .Subject = "Test"
                .Body = "Test"
                .Attachments.Add destinationWb.FullName
                .Send
            End With

            Set OutMail = Nothing
            Set OutApp = Nothing
        End If
    Next ws

    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
</code></pre>

<p>Edit: "It also fails even without an attachment. Essentially generating a message containing only the subject and text "test"."</p>

<p>Any suggestions for how to solve this? It would save a lot of time to not have to click Send for each individual mail, as the number of mails to send could potentially become quite large. </p>