Hide screen updating when sending mail with Outlook

Question

I have to send reports to over 400 email addresses (on column B). The filepaths for each report are on columns C, D and E.

With this post: How to add default signature in Outlook the signature is added when the .display method is used.

The signature I want to show is for user number 1. I've selected the corresponding signature as a default signature for new messages.

This signature contains a picture, but this doesn't seem to cause any problems.

I wouldn't want the macro to show the mail every time it sends the mail, because I want to avoid the constant blinking on the screen.

I tried to look for something like "hide" method from here but didn't find anything useful (.display would run in the background, and it would stay hidden from the user). Other idea was to add application.screenupdating = false and correspondingly true in the end, but this didn't have any impact.

How could I display the email in the background without showing it every time to the user?

Sub sendFiles_weeklyReports()

    Dim OutApp As Object
    Dim OutMail As Object

    Dim sh As Worksheet
    Dim EmailCell As Range
    Dim FileCell As Range
    Dim rng As Range

    Dim lastRow As Long
    Dim timestampColumn As Long
    Dim fileLogColumn As Long
    Dim i As Long

    Dim strbody As String
    Dim receiverName As String
    Dim myMessage As String
    Dim reportNameRange As String

    Dim answerConfirmation As Variant

Application.ScreenUpdating = False


    Set sh = Sheets("Report sender")
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.createitem(0)
    lastRow = sh.Cells(Rows.Count, "B").End(xlUp).Row
    i = 0
    reportNameRange = "C1:E1"
    timestampColumn = 17 'based on offset on EmailCell (column B)!
    fileLogColumn = 18 'based on offset on EmailCell (column B)!

    myMessage = "Are you sure you want to send weekly reports?" & vbNewLine & "'" & _
    sh.Range("C2").Value & "', " & vbNewLine & "'" & sh.Range("D2").Value & "' and " & vbNewLine & _
    "'" & sh.Range("E2").Value & "'?"

    answerConfirmation = MsgBox(myMessage, vbYesNo, "Send emails")


    If answerConfirmation = vbYes Then
        GoTo Start
    End If
    If answerConfirmation = vbNo Then
        GoTo Quit
    End If

Start:
    For Each EmailCell In sh.Range("B3:B" & lastRow)
        EmailCell.Offset(0, fileLogColumn).ClearContents
        EmailCell.Offset(0, timestampColumn).ClearContents

        Set rng = sh.Cells(EmailCell.Row, 1).Range(reportNameRange)

        If EmailCell.Value Like "?*@?*.?*" And Application.WorksheetFunction.CountA(rng) > 0 Then
            With OutMail
                For Each FileCell In rng
                    If Trim(FileCell) <> "" Then
                        If Dir(FileCell.Value) <> "" Then   'checks if there's a file path in the cell
                            .Attachments.Add FileCell.Value
                                EmailCell.Offset(0, fileLogColumn).Value = EmailCell.Offset(0, fileLogColumn).Value & ", " & _
                                Dir(FileCell.Value)
                                i = i + 1
                        End If
                    End If
                Next FileCell

                receiverName = EmailCell.Offset(0, -1).Value
                strbody = "Dear " & receiverName & "," & _
                "Please find attached the weekly reports." & _
                "Kind regards,"

                .SendUsingAccount = OutApp.Session.Accounts.Item(1)
                .To = EmailCell.Value
                .Subject = "Weekly Reporting – " & UCase("w") & "eek " & Format(Date, "ww") _
                & " " & UCase(Left(Format(Date, "mmmm"), 1)) & Right(Format(Date, "mmmm"), _
                Len(Format(Date, "mmmm")) - 1) & " " & Year(Now)

                .display
                .HTMLBody = strbody & .HTMLBody
                .Send
                EmailCell.Offset(0, timestampColumn).Value = Now
SkipEmail:
            End With

            Set OutMail = Nothing
        End If
    Next EmailCell

    Set OutApp = Nothing

Application.ScreenUpdating = True

    Call MsgBox("Weekly reports have been sent.", vbInformation, "Emails sent")
Quit:
End Sub

niton · Accepted Answer

Appears .GetInspector has the same functionality of .Display except the "display".

Sub generateDefaultSignature_WithoutDisplay()

    Dim OutApp As Object    ' If initiated outside of Outlook
    
    Dim OutMail As Object
    
    Dim strbody As String
    Dim receiverName As String
    
    receiverName = const_meFirstLast ' My name
        
    strbody = "Dear " & receiverName & "," & _
        "Please find attached the weekly reports." & _
        "Kind regards,"

    Set OutApp = CreateObject("Outlook.Application")    ' If initiated outside of Outlook
    Set OutMail = OutApp.CreateItem(0)
    
    With OutMail
 
        .SendUsingAccount = OutApp.Session.Accounts.Item(1)
        
        .To = const_emAddress ' My email address
        
        .Subject = "Weekly Reporting – " & UCase("w") & "eek " & Format(Date, "ww") _
          & " " & UCase(Left(Format(Date, "mmmm"), 1)) & Right(Format(Date, "mmmm"), _
          Len(Format(Date, "mmmm")) - 1) & " " & Year(Now)
        
        ' Default Signature
        '  Outlook 2013
        '  There is a report that .GetInspector is insufficient
        '   to generate the signature in Outlook 2016
        '.GetInspector ' rather than .Display
        ' Appears mailitem.GetInspector was not supposed to be valid as is
        
        ' .GetInspector is described here
        ' https://learn.microsoft.com/en-us/office/vba/api/outlook.mailitem.getinspector
        Dim objInspector As Inspector
        Set objInspector = .GetInspector
        
        .HTMLBody = strbody & .HTMLBody
        
        .Send

    End With
 
ExitRoutine:
    Set OutApp = Nothing
    Set OutMail = Nothing

End Sub

Hide screen updating when sending mail with Outlook

Answers (1)

Related Questions