Sending email alert from excel to Outlook

Question

I am trying to send a test mail from excel to Outlook, However I am getting error message : Run Time Error 287 in the following line :

OutMail.Send

Please find below my code:

Sub sendds()

    Dim OutMail As MailItem
    Dim outlookapp As Outlook.Application
     Dim myInspector As Outlook.Inspector

Set outlookapp = CreateObject("Outlook.application")
Set OutMail = outlookapp.CreateItem(olMailItem)

With OutMail

    .To = "email address"
    .Subject = "test mail"
    .Body = "Hi this is test email"


    OutMail.Send 'Getting error on this line


    End With


 Set outlookapp = Nothing
Set OutMail = Nothing


End Sub

Answer 1

That is because you have incorrect email or email address format should be email@email.com or for testing purpose use .Display

Also change it to just .Send

   With OutMail
        .To = "email@address.com"
        .Subject = "test"
        .Body = "Hi this is test email"
        .Send 
    End With

**For workaround **

    With olMail
        .To = "email"
        .CC = ""
        .BCC = ""
        .Subject = ""
        .Display
        .Send   
    End With

Answer 2

try the below:

Public Sub emailUsFeature()
Set outApp = CreateObject("Outlook.Application")
Set outMail = outApp.CreateItem(olMailItem)
With outMail
      .To = "abc@xyz.com; def@xyz.com"
      .CC = "ghi@xyz.com"
      .BCC = "jkl@xyz.com"
      .Subject = "This is the subject."
End With
outMail.display
End Sub

Answer 3

Based on the comment "when I am using outMail.display it displays the email which I want to send but I actually want to send the email" the code is too fast. It would likely as well work if you stepped through with F8.

You could use Excel's Wait to delay the send.

This should as well work for all applications and it would be the minimum waiting period.

Sub sendds_ErrorHandlerWait()

    Dim OutMail As MailItem
    Dim outlookapp As Outlook.Application
    Dim myInspector As Outlook.Inspector

    Set outlookapp = CreateObject("Outlook.application")
    Set OutMail = outlookapp.CreateItem(olMailItem)

    With OutMail

        .To = "email address"
        .Subject = "test mail"
        .body = "Hi this is test email"

        On Error GoTo ErrorHandler
        ' Err.Raise 287 ' for testing
        ' Err.Raise 1   ' for testing
        .Send
        On Error GoTo 0

    End With

ExitRoutine:
    Set outlookapp = Nothing
    Set OutMail = Nothing

    Exit Sub

ErrorHandler:

    Select Case Err

    Case 287
        DoEvents ' To accept clicks and to allow escaping if Outlook never opens
        Debug.Print " <Ctrl> + <Break> to escape"
        Resume

    Case Else
        On Error GoTo 0
        ' Break on other lines with an error
        Resume

End Select

End Sub

It appears your Outlook setup requires a display. If there is no fix for that situation, you may be able to use an invisible display.

Sub sendds_InspectorRatherThanDisplay()

    Dim OutMail As mailItem
    Dim outlookapp As Outlook.Application
    Dim myInspector As Outlook.Inspector

    Set outlookapp = CreateObject("Outlook.application")
    Set OutMail = outlookapp.CreateItem(olMailItem)

    With OutMail

        .To = "email address"
        .Subject = "test mail"
        .body = "Hi this is test email"

        Set myInspector = .GetInspector
        .Send

    End With

ExitRoutine:
    Set outlookapp = Nothing
    Set OutMail = Nothing
    Set myInspector = Nothing

End Sub

Answer 4

I am always adding in DoEvents and Application.Wait 1 to do this.

I usually don't display the email (and it is commented out here) so it just sends in the background. Works for me every time.

You obviously have to feed this sub from another with the arguments. An example of that is also here. (for example you could have the email address, file name etc. in each row and send an email dynamically for each row)

Sub LoopThroughTable()

    For i = 2 To Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row
        email_to = Sheet1.Cells(i, 4).Value
        email_subject = Sheet1.Cells(i, 3).Value
        email_body = Sheet1.Cells(i, 8).Value
        file_path = Sheet1.Cells(i, 2).Value & Sheet1.Cells(i, 3).Value

        SendOutlookMessage email_to, email_subject, file_path, email_body
    Next i

End Sub

Sub SendOutlookMessage(ByVal email_to As String, ByVal email_subject As String, ByVal file_path As String, ByVal email_body As String)

    emailTo = email_to
    emailSub = email_subject
    FullPath = file_path
    HTMLBODY = email_body

    DoEvents
    Application.Wait 1

    Dim olApp As Object
    Dim olMail As Object

    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(0)
    With olMail
        .to = emailTo
        .Subject = emailSub
        .Attachments.Add (FullPath)

        .HTMLBODY = HTMLBODY
        DoEvents

        '.Display
        Application.Wait 1
        .Send

    End With

    Application.Wait 1

    Set olMail = Nothing
    Set olApp = Nothing

End Sub

Hope that helps.