Wait until email is sent in Outlook before moving to next cell row

Question

This VBA code for Excel should take info from specific cells in each row to populate an automated email follow up.

The code moves through each row of the sheet and opens an email draft in Outlook. This is problematic when the sheet has too many lines, Outlook will typically crash.

I tried using various loops but it either breaks the script or causes the draft to reopen forcing me to have to kill Outlook.

Is there a way to have open the draft and wait until the window is either closed or sent before it moves on to the next line?

I am using .Display rather than .Send so that the email drafts can be reviewed, edited, or cancelled prior to send.

Is there something that checks for .Display = True before moving to the new row in Excel?

Sub SendEmails()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim Name As String
    Dim FirstName As String
    Dim LastName As String
    Dim Temp

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    On Error GoTo cleanup

    For Each cell In Columns("W").Cells.SpecialCells(xlCellTypeConstants)
        i = cell.Row                                                                
        Temp = Split(Sheets("Sheet1").Range("P" & i).Value)                         
        FirstName = WorksheetFunction.Proper(Temp(LBound(Temp)))                   

        If Sheets("Sheet1").Range("A" & i).Value = "Yellow" And Sheets("Sheet1").Range("AE" & i).Value = "Red" Then
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = cell.Value
                .subject = "Yellow Red" & Sheets("Sheet1").Range("A" & i).Value & " - " & Sheets("Sheet1").Range("D" & i).Value
                .HTMLBody = "<p>Good Afternoon " & FirstName & "," & "</p>" & "<p>Thank you for Yellow.</p>" & "<p> Thanks </p>"
                .Display
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If

        If Sheets("Sheet1").Range("A" & i).Value = "Blue" Then
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = cell.Value
                .subject = "Blue" & Sheets("Sheet1").Range("A" & i).Value & " - " & Sheets("Sheet1").Range("D" & i).Value
                .HTMLBody = "<p>Good Afternoon " & FirstName & "," & "</p>" & "<p>Thank you for Blue.</p>" & "<p> Thanks </p>"
                .Display
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If

        If Sheets("Sheet1").Range("A" & i).Value = "Yellow" And Sheets("Sheet1").Range("AE" & i).Value <> "Red" Then
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = cell.Value
                .subject = "Yellow" & Sheets("Sheet1").Range("A" & i).Value & " - " & Sheets("Sheet1").Range("D" & i).Value
                .HTMLBody = "<p>Good Afternoon " & FirstName & "," & "</p>" & "<p>Thank you for Yellow .</p>" & "<p> Thanks </p>"
                .Display
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If

   Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True

End Sub

When you change this to .Send you should be fine. Outlook is crashing since you are forcing so many windows to open. When you change to .Send, there is less UI processing and your instance of outlook is less likely to crash. You should test first of course (just send yourself all the emails) — urdearboy
You could also speed things up here by switching to a ELSE IF to avoid running each value in your loop through every single test assuming each cell should only return TRUE for one instance. If it is TRUE for the first test, why run it through the next 2 knowing the result will be FALSE? — urdearboy
It looks like all of your email bodies are the exact same. Why not just have the body be a variable? Then you just have one section to draft the email.... — urdearboy
@urdearboy I will change to Else If statements. That makes sense. For the email bodies, in my real code they do not say what is said here. It was very specific outputs so i dumbed it down just for the post. Like you said, .Send should solve the problem but I'd prefer close out of drafts than edit the spreadsheet on the frontend — Daruco

Sergiu Sergiu · Accepted Answer · 2019-11-28T05:52:59

not tested

first of all , sorry for replying with answer, i cannot comment due to not enough rep. Ok i did some research online on your question, you might want to look into .Display True

It seems adding "True" to the display it makes the pop-up window modal. being modal puts the loop on hold until you click the send the email.

just wanted to let you know about this , but cant comment.

Wait until email is sent in Outlook before moving to next cell row

1 Answers