Send Emails via Excel VBA one at a time

Question

I am using MS Excel and Outlook 2013. I am trying to automate an Excel spreadsheet that sends 5 emails to a specified address using Outlook.

The trick is I want each message to display one at a time and only move on to the next message when the user either hits Send or closes the message. Here is what I have so far:

    Sub Send_Emails()

    Dim OutApp As Object: Set OutApp = CreateObject("Outlook.Application")
    Dim OutMail As Object: Set OutMail = OutApp.CreateItem(0)

   'Send Email
   With OutMail
      .to = "john.doe@mycompany.com"
      .Subject = "This is the Subject"
      .Body = "This is message"
      .Display
   End With

   On Error Resume Next:
   OutMail = Nothing
   OutApp = Nothing
   End Sub

   Sub Send_Five_Emails()
   For i = 1 To 5 'Send email 5 times
       Call Send_Emails
   Next i
   End Sub

The problem with this code is that it displays all 5 message windows at once. Is there a way to make the Close event of one message window trigger the Displaying of the next one, so as to make them appear one at a time?

I appreciate the help.

Answer 1

Use .Display (True)

The expression.Display(Modal) argument is used with all objects except for the Explorer and MAPIFolder objects, True to make the window modal. The default value is False .

See Display Method on MSDN