Sub A()
' メールを開いてPDFをアタッチする()
Dim olApp As Object
Dim olMail As Object
Dim MailSubject As String
Dim MSGFilePath As String
Dim AttachmentPaths() As String
Dim i As Integer
' Outlook アプリケーションを取得
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
On Error GoTo 0
' Outlook アプリケーションが起動していない場合は新規に起動
If olApp Is Nothing Then
Set olApp = CreateObject("Outlook.Application")
End If
' ◆MSGファイルのパス
MSGFilePath = "Z:\KB .msg"
' MSGファイルが存在するか確認
If Dir(MSGFilePath) <> "" Then
' 新規メール作成
Set olMail = olApp.CreateItemFromTemplate(MSGFilePath)
' ◆添付ファイルのパスを配列に設定
ReDim AttachmentPaths(1 To 2)
AttachmentPaths(1) = "Z:\手配書\引き取り依頼.PDF"
AttachmentPaths(2) = "Z:\宜しくお願い致します。.PDF"
' 添付ファイルをループして追加
For i = LBound(AttachmentPaths) To UBound(AttachmentPaths)
' 添付ファイルが存在するか確認
If Dir(AttachmentPaths(i)) <> "" Then
' メールに添付ファイルを追加
olMail.Attachments.Add AttachmentPaths(i)
Else
MsgBox "指定された添付ファイルが見つかりません。", vbExclamation
End If
Next i
' メールを表示
olMail.Display
Else
MsgBox "指定されたMSGファイルが見つかりません。", vbExclamation
End If
End Sub