複数の対象者へ添付メールを２通添付し送信する方法について（ご質問）

前提・実現したいこと

初心者です。
複数の対象者へ添付メールを２通添付し送信したいと思っております。
２通目の添付をどのような式にすればよいかわからずご教授ください。

該当のソースコード

Sub ボタン1_Click()

Dim SendMailadd As String
Dim rowcounter As Integer
Dim SendTo As String
Dim MailTitle As String
Dim MailBody As String

'5行目からのデータを取得
rowcounter = 5

With Sheets("Sheet1")
    
    '送信元アドレス取得
    SendFrom = Cells(2, 1)
    
     
    '5行目から宛先が空になるまでループ
    Do Until Cells(rowcounter, 1) = ""
    
        SendTo = Cells(rowcounter, 1)
        SendCC = Cells(rowcounter, 2)
        SendBCC = Cells(rowcounter, 3)
        MailTitle = Cells(rowcounter, 4)
        MailBody = Cells(rowcounter, 5) & vbCrLf & Cells(rowcounter, 6) & vbCrLf & Cells(rowcounter, 7) & vbCrLf & vbCrLf & Cells(rowcounter, 9)
        AttachFile = Cells(rowcounter, 10)
        
        'メール送信
        Call SendMail(SendFrom, SendTo, SendCC, SendBCC, MailTitle, MailBody, AttachFile)
        
        rowcounter = rowcounter + 1
    
    Loop


End With

End Sub
' メール配信する
Sub SendMail(SendFrom, SendTo, SendCC, SendBCC, MailTitle, MailBody, AttachFile)

On Error GoTo ErrorHandler

Set oApp = CreateObject("Outlook.Application")
Set objMAIL = oApp.CreateItem(0)

objMAIL.SentOnBehalfOfName = SendFrom


objMAIL.BodyFormat = 2          'HTML形式
objMAIL.Subject = MailTitle     ' 件名
objMAIL.Body = MailBody         ' 本文
objMAIL.To = SendTo
objMAIL.CC = SendCC
objMAIL.BCC = SendBCC
If AttachFile <> "" Then
    objMAIL.Attachments.Add AttachFile
End If

objMAIL.Display

' メール送信
objMAIL.Save

Set objMAIL = Nothing
Set oApp = Nothing

Exit Sub

ErrorHandler:

MsgBox (Err.Description)

End Sub

jinoji

2021/12/09 14:10

１つめの添付ファイルはJ列に書かれているようですが、２つめはどこに書かれているでしょうか。

dddaaabbb3

2021/12/10 00:34

ご連絡をいただきありがとうございます。 AttachFile = Cells(rowcounter, 10) の下に AttachFile = Cells(rowcounter, 11)と追加してみましたが２つ目の添付ファイルがつきませんでした。 Attachfileでは２つ目の添付ができないのかもしれないのですが、ご教授いただけますと幸いです。

行動規範の内容に同意します

回答1件

こんな感じでどうでしょうか。

VBA
1'Sub ボタン1_Click()
2
3    AttachFile = Array(Cells(rowcounter, 10), Cells(rowcounter, 11))
4
5
6
7'Sub SendMail(SendFrom, SendTo, SendCC, SendBCC, MailTitle, MailBody, AttachFile)
8
9    Dim f
10    For Each f In AttachFile
11        If f <> "" Then objMAIL.Attachments.Add f
12    Next
13

投稿2021/12/10 01:19

jinoji

総合スコア4592

dddaaabbb3

2021/12/13 01:07

ご連絡をいただきありがとうございました。お返事が遅くなり申し訳ございません。私の条件式で変更をしなければいけない箇所があったのかもしれませんが、エラーとなってしまいまして度々申し訳ございませんがお教えいただけますと助かります。 '5行目から宛先が空になるまでループ Do Until Cells(rowcounter, 1) = "" SendTo = Cells(rowcounter, 1) SendCC = Cells(rowcounter, 2) SendBCC = Cells(rowcounter, 3) MailTitle = Cells(rowcounter, 4) MailBody = Cells(rowcounter, 5) & vbCrLf & Cells(rowcounter, 6) & vbCrLf & Cells(rowcounter, 7) & vbCrLf & vbCrLf & Cells(rowcounter, 9) AttachFile = Array(Cells(rowcounter, 10), Cells(rowcounter, 11)) 'メール送信 Call SendMail(SendFrom, SendTo, SendCC, SendBCC, MailTitle, MailBody, AttachFile) rowcounter = rowcounter + 1 Loop End With End Sub ' メール配信する Sub SendMail(SendFrom, SendTo, SendCC, SendBCC, MailTitle, MailBody, AttachFile) Dim f For Each f In AttachFile If f <> "" Then objMAIL.Attachments.Add f Next