【发布时间】：2018-04-21 06:06:32
【问题描述】：
我必须向 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
【问题讨论】：
-
可能很难确定潜在响应者需要什么，但在提问时尽量省略。例如，响应者没有合适的 Excel 工作簿，因此您可以尝试在没有它的情况下设置问题。 stackoverflow.com/help/mcve
-
感谢您的反馈！由于我是该站点的新手，因此需要一些时间来熟悉最佳实践。我已经看到很多问题，人们要求查看整个代码而不是其中的一部分，所以我认为这将是最好的解决方案。您提供的链接也很有帮助，谢谢！