【VBA】Outlookで自動メール送信

参考
https://www.fastclassinfo.com/entry/vba_outlook_sendmail#%E3%82%A2%E3%82%A6%E3%83%88%E3%83%AB%E3%83%83%E3%82%AF%E6%93%8D%E4%BD%9C%E3%83%87%E3%83%A1%E3%83%AA%E3%83%83%E3%83%88

Option Explicit
Sub sendMail() '

'---コード1｜outlookを起動する
    Dim toaddress, ccaddress, bccaddress As String  '変数設定：To宛先、cc宛先、bcc宛先
    Dim subject, header, mailBody, mailBody_head, mailBody_middle, mailBody_tail, credit As String '変数設定：件名、メール本文、クレジット、添付
    Dim outlookObj As Outlook.Application    'Outlookで使用するオブジェクト生成
    Dim mailItemObj As Outlook.mailItem      'Outlookで使用するオブジェクト生成
    Dim i As Long

    Dim objOutlooksheet As Worksheet
    Set objOutlooksheet = ThisWorkbook.Worksheets("Mail")
    
'---コード2｜差出人、本文、署名を取得する---
    toaddress = objOutlooksheet.Range("B2").Value   'To宛先
    ccaddress = objOutlooksheet.Range("B3").Value   'cc宛先
    bccaddress = objOutlooksheet.Range("B4").Value  'bcc宛先
    subject = objOutlooksheet.Range("B5").Value     '定型
    header = objOutlooksheet.Range("B6").Value     '件名
    mailBody_head = objOutlooksheet.Range("B7").Value    'メール本文頭
'    mailBody_middle = objOutlooksheet.Range("B8").Value    'メール本文中
    mailBody_tail = objOutlooksheet.Range("B9").Value    'メール本文末
    credit = objOutlooksheet.Range("B10").Value      'クレジット

'---コード3｜メールを作成して、差出人、本文、署名を入れ込む---
    Set outlookObj = CreateObject("Outlook.Application")
    Set mailItemObj = outlookObj.CreateItem(olMailItem)
    mailItemObj.BodyFormat = 3      'リッチテキストに変更
    mailItemObj.To = toaddress      'to宛先をセット
    mailItemObj.cc = ccaddress      'cc宛先をセット
    mailItemObj.BCC = bccaddress    'bcc宛先をセット
    mailItemObj.subject = subject   '件名をセット
    
'---コード4｜メール本文を改行する
'    i = 2
'    With Worksheets("Sheet2")
'        Do While .Cells(i, 1) = "○"
'            mailBody_middle = mailBody_middle & .Cells(i, 2) & "/" & .Cells(i, 3) & ":" & .Cells(i, 5) & vbCrLf
'            i = i + 1
'        Loop
'    End With

    mailBody = mailBody_head & vbCrLf & mailBody_middle & vbCrLf & mailBody_tail
    mailItemObj.Body = header & vbCrLf & vbCrLf & mailBody & vbCrLf & vbCrLf & credit   'メール本文 改行 改行 クレジット
    
'---コード5｜自動で添付ファイルを付ける---
'    Dim attached As String
'    Dim myattachments As Outlook.Attachments 'Outlookで使用するオブジェクト生成
'    Set myattachments = mailItemObj.Attachments
'    attached = objOutlooksheet.Range("B9").Value     '添付ファイル
'    If attached <> "" Then myattachments.Add attached

'---コード6｜メールを送信する---
    'mailItemObj.Save   '下書き保存
    mailItemObj.Display  'メール表示(ここでは誤送信を防ぐために表示だけにして、メール送信はしない)
    'mailItemObj.Send    'メール送信

'---コード7｜outlookを閉じる(オブジェクトの解放)---
    Set outlookObj = Nothing
    Set mailItemObj = Nothing

End Sub