Question

我必须向超过400个电子邮件地址发送报告（在B栏上）。每个报告的文件路径位于C，D和E列。

使用此帖子：How to add default signature in Outlook使用.display方法时会添加签名。

我想要显示的签名是针对用户编号1.我已选择相应的签名作为新消息的默认签名。

此签名包含图片，但这似乎不会导致任何问题。

我不希望宏在每次发送邮件时显示邮件，因为我想避免屏幕上不断闪烁。

我试图从here中寻找类似“隐藏”方法的内容，但没有找到任何有用的内容（。display会在后台运行，并且会对用户保持隐藏状态）。其他想法是最后添加application.screenupdating = false和相应的true，但这没有任何影响。

如何在不向用户显示的情况下在后台显示电子邮件？

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 = "<BODY style=font-size:11pt;font-family:Calibri><p>Dear " & receiverName & ",</p>" & _
                "<p>Please find attached the weekly reports.</p>" & _
                "<p>Kind regards,</p></BODY>"

                .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

Answer 1

显示.GetInspector具有与.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 = "<BODY style=font-size:11pt;font-family:Calibri><p>Dear " & receiverName & ",</p>" & _
        "<p>Please find attached the weekly reports.</p>" & _
        "<p>Kind regards,</p></BODY>"

    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

        .HTMLBody = strbody & .HTMLBody

        .Send

    End With

ExitRoutine:
    Set OutApp = Nothing
    Set OutMail = Nothing

End Sub

使用Outlook

1 个答案: