outlookで一括送信できるVBA

エクセルのL列(3～46) M列(5,40)に入力されたスマホのメールアドレス(45件)に一括送信できるVBAを教えてください。
よろしくお願いいたします。

No.3 回答者： Qchan1962 回答日時： 2020/04/07 19:16

＞Dim wsList As Worksheet: Set wsList = ActiveSheet 'ThisWorkbook.Sheets("名前")

＞名前をシート名に変更すればよいですか？
はい、
Dim wsList As Worksheet: Set wsList =ThisWorkbook.Sheets("名前")

No.2 回答者： Qchan1962 回答日時： 2020/04/07 13:55

>自分はVBA、ほとんど分かりません。

これを標準モジュールに張り付ければよろしいですか？

標準モジュールに張り付け、SendEmailがボタンなどに登録する実行プロシージャになります。
ただ回答したコードは
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")
などとしていない為、参照設定が必要になります。参考サイトをご覧いただき設定してください。

参考　https://tonari-it.com/vba-outlook-object/

簡単な説明を加えると
Sub SendEmail()内でメールに必要な内容を変数に入れて下記に投げると（必要情報抽出、下記に送らせるの（Range("L3:L36,M5,M40") 'メールアドレス範囲分）繰り返し

Function OL_SendEmail(Mail_To As String, Mail_Cc As String, Mail_Body As String, Mail_Subject As String)で
Mail_To , Mail_Cc , Mail_Body , Mail_Subject の情報を受け取り新規メールを作り送信しています。

Sub SendEmail()は、
件名や本文など改修する必要があります。
例などを参考にテストしてください。

Function部分については下記の部分を設定してください。
　　　　.Display '表示不要な場合削除　作成して表示まで
　　　　'　　　　.Send　'送信　’　を削除すると送信されます。

具体的な表組（添付図）や情報があれば、アドバイスし易くなります。

この回答へのお礼

ありがとうございます。
参照設定は出来ました。
が、説明を読んでもよく分かりません。
Dim wsList As Worksheet: Set wsList = ActiveSheet 'ThisWorkbook.Sheets("名前")
名前をシート名に変更すればよいですか？

お礼日時：2020/04/07 18:08

No.1 回答者： Qchan1962 回答日時： 2020/04/07 11:20

Excel,OutlookのVBAの基礎知識があるとして回答いたします。

一括送信を行う場合、メールアドレスを　; で繋げる方法とMailItemを都度作成して送信する方法（厳密には一括ではない）があります。
ご質問の45件の場合、送信宛先、文字数制限に制限され実行できない場合がありますので、
都度作成して送信する方法にした方が良いでしょう。

また、MailItem作成、処理を多く行う場合にメモリースタックのリスクもありますので
実行部分をサブにします。（45件なら問題ないと思いますが）

Dim objOutlook As OutLook.Application
Sub SendEmail()
Dim j As Long, Tgt As Variant
Dim Mail_To As String, Mail_Cc As String, Mail_Body As String, Mail_Subject As String
Dim wsList As Worksheet: Set wsList = ActiveSheet 'ThisWorkbook.Sheets("名前")
Dim rc As Integer
　　rc = MsgBox("メール配信処理を行いますか？", vbYesNo + vbQuestion, "確認")
　　If rc = vbYes Then
　　　　j = 0
　　　　For Each Tgt In wsList.Range("L3:L36,M5,M40") 'メールアドレス範囲
　　　　　　Mail_To = Tgt.Value　　　　'メール宛先
　　　　　　Mail_Cc = ""
　　　　　　Mail_Subject = ""　　　　'メール件名
　　　　　　Mail_Body = ""　　 'メール本文
　　　　　　'本文例
'　　　　　　Mail_Body =Tgt.Offset(, -3).Value & vbCrLf & _
'　　　　　　　　　　　　Tgt.Offset(, -2).Value & " " & _
'　　　　　　　　　　　　Tgt.Offset(, -1).Value & " 様" & vbCrLf & vbCrLf & _
'　　　　　　　　　　　　”本文” & vbCrLf & ”署名”
　　　　　　Call OL_SendEmail(Mail_To, Mail_Cc, Mail_Body, Mail_Subject)
　　　　　　j = j + 1
　　　　Next Tgt
　　　　MsgBox j & "件　送信完了"
　　　　If objOutlook Is Nothing Then Set objOutlook = Nothing
　　　　Set wsList = Nothing
　　　　Set wsMail = Nothing
　　End If
End Sub
Function OL_SendEmail(Mail_To As String, Mail_Cc As String, Mail_Body As String, Mail_Subject As String)
　　Dim objMail As OutLook.MailItem
　　Set objOutlook = New OutLook.Application
　　Set objMail = objOutlook.CreateItem(olMailItem)
　　With objMail
　　　　.To = Mail_To
　　　　.CC = Mail_Cc
　　　　.Subject = Mail_Subject
　　　　.BodyFormat = olFormatPlain　　 'メールの形式
　　　　.Body = Mail_Body
　　　　.Display '表示不要な場合削除
　　　　'　　　　.Send　'送信　Test時コメントにする
　　End With
　　Set objMail = Nothing
End Function

例　添付図

この回答へのお礼

ありがとうございます。
すみません、自分はVBA、ほとんど分かりません。
これを標準モジュールに張り付ければよろしいですか？

お礼日時：2020/04/07 13:15