【サンプルファイル付き】複数の宛先への添付ファイル付きメールを一括で自動作成する方法【ExcelVBA】

Sub mail_create_ikkatu()

Dim objOutlook As Outlook.Application
Dim i
Dim rowMax As Long
Dim wsList As Worksheet
Dim wsMail As Worksheet
Dim objMail As Outlook.MailItem

Set objOutlook = New Outlook.Application
Set wsList = ThisWorkbook.Sheets("送信先")
Set wsMail = ThisWorkbook.Sheets("メール内容")


'---添付ファイル1---
Dim attachmentPath1 As String
    attachmentPath1 = wsMail.Range("B3")
 
'---添付ファイル2---
Dim attachmentPath2 As String
    attachmentPath2 = wsMail.Range("B4")
    

With wsList

    '送信先シートの件数
    rowMax = .Cells(Rows.Count, 1).End(xlUp).Row

    '送信先の件数分繰り返す
    For i = 2 To rowMax
        Set objMail = objOutlook.CreateItem(olMailItem)
        With wsMail
            objMail.To = wsList.Cells(i, 4).Value       'メール宛先
            objMail.CC = wsList.Cells(i, 5).Value       'メール宛先 CC
            objMail.BCC = wsList.Cells(i, 6).Value       'メール宛先 BCC
            objMail.Subject = .Range("B1").Value        'メール件名
            objMail.BodyFormat = olFormatPlain          'メールの形式
            objMail.Body = wsList.Cells(i, 1).Value & vbCrLf & _
                         wsList.Cells(i, 2).Value & " " & _
                         wsList.Cells(i, 3).Value & " 様" & vbCrLf & vbCrLf & _
                        .Range("B2").Value              'メール本文
'---添付ファイルを添付する---
'添付ファイルが空欄の場合は次へ                        
    If attachmentPath1 = "" Then
        GoTo Label1
    Else
        objMail.Attachments.Add (attachmentPath1)    '添付ファイル1
    End If

Label1:

     If attachmentPath2 = "" Then
        GoTo Label2
    Else
        objMail.Attachments.Add (attachmentPath2)    '添付ファイル2
    End If

Label2:
            
            
'--- メールを表示 ---
    objMail.Display
    
'--- メールを送付 ---
    'objMail.Send

        End With
    Next i

    Set objOutlook = Nothing
    MsgBox "作成完了"

End With

End Sub

Sub tenpfile()

Dim wsMail As Worksheet

Set wsMail = ThisWorkbook.Sheets("メール内容")

'--- ファイル選択ダイアログ ---'
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogOpen)
    
    '--- 選択可能なファイルの種類 ---'
    Call fd.Filters.Clear
    
     '--- ダイアログボックスの見出し（左上のやつ） ---'
    fd.Title = "添付ファイルの選択"
    
    '--- 初期表示フォルダ ---'
    fd.InitialFileName = "ファイルを選択してください"
    
    '--- 表示アイコンの大きさ ---'
    fd.InitialView = msoFileDialogViewSmallIcons

    '--- ファイルパスを格納する変数 ---'
    Dim strFilePath As String
    
    '--- 有効なボタンがクリックされた時の処理 ---
    If (fd.Show = True) Then
        strFilePath = fd.SelectedItems.Item(1)
    Else
        strFilePath = ""
    End If

'MsgBox (strFilePath)

 wsMail.Range("B3").Value = strFilePath




End Sub