Sub AutoEmail_Consultant2()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim strbody As String

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Set OutApp = CreateObject("Outlook.Application")

    On Error GoTo cleanup

    For Each cell In Columns("A").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" Then

            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = cell.Value
                .Subject = "Payment Reminder"
                .HTMLBody = "Dear " & Cells(cell.Row, "B").Value & "," & vbNewLine & "This email is reminder for payment of " & Cells(cell.Row, "D").Value & " against invoice no: " & Cells(cell.Row, "C").Value & "."
                '.Send
                .Display
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If
    Next cell

cleanup:
    Set OutApp = Nothing

    Application.ScreenUpdating = True
End Sub