Sam*_*ppa 5 email excel outlook vba
我必须将报告发送到 400 多个电子邮件地址（B 列）。每个报告的文件路径位于 C、D 和 E 列。
\n\n通过这篇文章：如何在 Outlook 中添加默认签名，.display使用该方法时会添加签名。
我要显示的签名是用户号 1 的签名。我已选择相应的签名作为新消息的默认签名。
\n\n该签名包含图片，但这似乎不会造成任何问题。
\n\n我不希望宏每次发送邮件时都显示邮件，因为我想避免屏幕上不断闪烁。
\n\n我试图从这里寻找类似“隐藏”方法的东西，但没有找到任何有用的东西（.display会在后台运行，并且会对用户隐藏）。另一个想法是添加application.screenupdating = false并相应地true，但这没有任何影响。
如何在后台显示电子邮件而不是每次都向用户显示？
\n\nSub sendFiles_weeklyReports()\n\n Dim OutApp As Object\n Dim OutMail As Object\n\n Dim sh As Worksheet\n Dim EmailCell As Range\n Dim FileCell As Range\n Dim rng As Range\n\n Dim lastRow As Long\n Dim timestampColumn As Long\n Dim fileLogColumn As Long\n Dim i As Long\n\n Dim strbody As String\n Dim receiverName As String\n Dim myMessage As String\n Dim reportNameRange As String\n\n Dim answerConfirmation As Variant\n\nApplication.ScreenUpdating = False\n\n\n Set sh = Sheets("Report sender")\n Set OutApp = CreateObject("Outlook.Application")\n Set OutMail = OutApp.createitem(0)\n lastRow = sh.Cells(Rows.Count, "B").End(xlUp).Row\n i = 0\n reportNameRange = "C1:E1"\n timestampColumn = 17 \'based on offset on EmailCell (column B)!\n fileLogColumn = 18 \'based on offset on EmailCell (column B)!\n\n myMessage = "Are you sure you want to send weekly reports?" & vbNewLine & "\'" & _\n sh.Range("C2").Value & "\', " & vbNewLine & "\'" & sh.Range("D2").Value & "\' and " & vbNewLine & _\n "\'" & sh.Range("E2").Value & "\'?"\n\n answerConfirmation = MsgBox(myMessage, vbYesNo, "Send emails")\n\n\n If answerConfirmation = vbYes Then\n GoTo Start\n End If\n If answerConfirmation = vbNo Then\n GoTo Quit\n End If\n\nStart:\n For Each EmailCell In sh.Range("B3:B" & lastRow)\n EmailCell.Offset(0, fileLogColumn).ClearContents\n EmailCell.Offset(0, timestampColumn).ClearContents\n\n Set rng = sh.Cells(EmailCell.Row, 1).Range(reportNameRange)\n\n If EmailCell.Value Like "?*@?*.?*" And Application.WorksheetFunction.CountA(rng) > 0 Then\n With OutMail\n For Each FileCell In rng\n If Trim(FileCell) <> "" Then\n If Dir(FileCell.Value) <> "" Then \'checks if there\'s a file path in the cell\n .Attachments.Add FileCell.Value\n EmailCell.Offset(0, fileLogColumn).Value = EmailCell.Offset(0, fileLogColumn).Value & ", " & _\n Dir(FileCell.Value)\n i = i + 1\n End If\n End If\n Next FileCell\n\n receiverName = EmailCell.Offset(0, -1).Value\n strbody = "<BODY style=font-size:11pt;font-family:Calibri><p>Dear " & receiverName & ",</p>" & _\n "<p>Please find attached the weekly reports.</p>" & _\n "<p>Kind regards,</p></BODY>"\n\n .SendUsingAccount = OutApp.Session.Accounts.Item(1)\n .To = EmailCell.Value\n .Subject = "Weekly Reporting \xe2\x80\x93 " & UCase("w") & "eek " & Format(Date, "ww") _\n & " " & UCase(Left(Format(Date, "mmmm"), 1)) & Right(Format(Date, "mmmm"), _\n Len(Format(Date, "mmmm")) - 1) & " " & Year(Now)\n\n .display\n .HTMLBody = strbody & .HTMLBody\n .Send\n EmailCell.Offset(0, timestampColumn).Value = Now\nSkipEmail:\n End With\n\n Set OutMail = Nothing\n End If\n Next EmailCell\n\n Set OutApp = Nothing\n\nApplication.ScreenUpdating = True\n\n Call MsgBox("Weekly reports have been sent.", vbInformation, "Emails sent")\nQuit:\nEnd Sub\n除了“显示”之外，看起来.GetInspector具有相同的功能。.Display
Sub generateDefaultSignature_WithoutDisplay()\n\n Dim OutApp As Object ' If initiated outside of Outlook\n \n Dim OutMail As Object\n \n Dim strbody As String\n Dim receiverName As String\n \n receiverName = const_meFirstLast ' My name\n \n strbody = "<BODY style=font-size:11pt;font-family:Calibri><p>Dear " & receiverName & ",</p>" & _\n "<p>Please find attached the weekly reports.</p>" & _\n "<p>Kind regards,</p></BODY>"\n\n Set OutApp = CreateObject("Outlook.Application") ' If initiated outside of Outlook\n Set OutMail = OutApp.CreateItem(0)\n \n With OutMail\n \n .SendUsingAccount = OutApp.Session.Accounts.Item(1)\n \n .To = const_emAddress ' My email address\n \n .Subject = "Weekly Reporting \xe2\x80\x93 " & UCase("w") & "eek " & Format(Date, "ww") _\n & " " & UCase(Left(Format(Date, "mmmm"), 1)) & Right(Format(Date, "mmmm"), _\n Len(Format(Date, "mmmm")) - 1) & " " & Year(Now)\n \n ' Default Signature\n ' Outlook 2013\n ' There is a report that .GetInspector is insufficient\n ' to generate the signature in Outlook 2016\n '.GetInspector ' rather than .Display\n ' Appears mailitem.GetInspector was not supposed to be valid as is\n \n ' .GetInspector is described here\n ' https://learn.microsoft.com/en-us/office/vba/api/outlook.mailitem.getinspector\n Dim objInspector As Inspector\n Set objInspector = .GetInspector\n \n .HTMLBody = strbody & .HTMLBody\n \n .Send\n\n End With\n \nExitRoutine:\n Set OutApp = Nothing\n Set OutMail = Nothing\n\nEnd Sub\n