ExcelVBAで添付ファイルをつけたいです。

質問

Excelで顧客のアドレス帳を作成しており、そのアドレス帳全員に同じ文面でメールを送信したいと思い、マクロを作成しております。

調べながらここまではきたのですが、添付ファイルが着きません。
お手数ですが、どなたか自身のデスクトップ上にあるフォルダ内のPDFを
全メールに添付する方法を教えて頂けますでしょうか。

実行しようとすると「添付できるのは、ファイルかオブジェクトに限られます。」と出てしまいます。

ご教示の程、宜しくお願い致します。

下記書いたコードです。

Sub 自動送信Sample()

Dim OL As Outlook.Application
Dim MI As Outlook.MailItem
Dim R_Start As Integer, R_End As Integer
Dim Tenp1 As String, Tenp2 As String

Set OL = CreateObject("Outlook.Application")
Tenp1 = Worksheets("Sheet1").Range("B4") '添付1
Tenp2 = Worksheets("Sheet1").Range("B5") '添付2
R_Start = Worksheets("Sheet1").Range("G2") + 7 '開始番号（開始行）
R_End = Worksheets("Sheet1").Range("I2") + 7 '終了番号（終了行）

For R_Start = R_Start To R_End
Set MI = OL.CreateItem(olMailItem)

MI.SentOnBehalfOfName = Worksheets("Sheet1").Range("B2") '差出人
MI.Subject = Worksheets("Sheet1").Range("B3") '件名
MI.To = Worksheets("Sheet1").Cells(R_Start, "B") 'To
MI.CC = Worksheets("Sheet1").Cells(R_Start, "C") 'CC
MI.BCC = Worksheets("Sheet1").Cells(R_Start, "D") 'BCC

'添付
If Tenp1 <> "" Then
MI.Attachments.Add Tenp1
End If
If Tenp2 <> "" Then
MI.Attachments.Add Tenp2
End If

'本文
MI.Body = Worksheets("Sheet1").Cells(R_Start, "E") & vbCr _
& Worksheets("Sheet1").Cells(R_Start, "F") & vbCr & vbCr _
& Worksheets("Sheet2").Range("A3")

MI.Display 'メール表示
Next

Set OL = Nothing
Set MI = Nothing

MsgBox "完了！"
End Sub

回答No.1

kkkkkm · ベストアンサー

コードは問題がなさそうです。正常に添付ファイルつきで実行できます。
Range("B4") 、Range("B5") のファイルの指定がおかしいのかもしれませんね。