1
400件以上のメールアドレス（B列）にレポートを送信する必要があります。各レポートのファイルパスはC、D、E列にあります。Outlookでメールを送信するときの画面の非表示
この記事では、.displayメソッドを使用した場合には、How to add default signature in Outlookの署名が追加されています。
私が表示したい署名は、ユーザ番号1のものです。私は、対応する署名を新しいメッセージのデフォルト署名として選択しました。
このシグネチャには画像が含まれていますが、問題は発生していません。
メールを送信するたびにマクロを表示させたくないのは、画面上で絶え間なく点滅するのを避けたいからです。 から「hide」メソッドのようなものを探してみましたが、役に立たないものは見つかりませんでした。（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ワークブックを持っていないので、質問なしで質問を設定しようとすることができます。 https://stackoverflow.com/help/mcve – niton
フィードバックいただきありがとうございます！私がサイトを初めて知りましたので、ベストプラクティスに慣れるまでには時間がかかります。私は、人々がコードの一部ではなくコード全体を見るように尋ねるところで、非常に多くの質問をしてきたので、これが最善の解決策であると考えました。あなたが提供したリンクもとても役に立ちました。ありがとう！ – Samppa