ExcelVbaからOutlookのメール作成、RTF（リッチテキストフォーマット）で文中に添付ファイルを貼る

ExcelVbaからOutlookのメール作成、
RTF（リッチテキストフォーマット）で文中に添付ファイルを貼る

解説

通常、HTML形式で作成するが、RTFであれば、文中に添付ファイルを位置を決めて埋め込むことができる。
たとえば、表組み（テーブル）に、添付ファイルごとに解説・説明付きで、表現することができる。
この、RTFで添付ファイルを埋め込む形式での、Outlookメールを、ExcelVBAで作成する場合の例が以下。

メール文書内の、文書成型は、ワードのオブジェクトとして実施するのがミソ（WordEditorで、docを得ている箇所）

vbaでのword操作は、「Range」を使いこなすのが大事。doc内を、Paragraphsや、Sentencesを、for文で順にみていくことが可能。この時、Paragraphsの要素は、Paragraphだが、Sentencesの要素はSentenceではなく、Range。

ソース

Excel2Outlook_SendMail_RTF

'要、参照設定　：　Microsoft Word 16.0 Object Library

Option Explicit

Public Sub Excel2Outlook_SendMail_RTF()

Dim wb As Workbook
Set wb = ActiveWorkbook

' エクセルの表組みをコピー
' 領域は適宜
'/---------------
wb.Sheets("Sheet1").Range("A1:C3").Copy
'/---------------
Dim myol, mymail, ins, doc
Set myol = CreateObject("Outlook.Application")
Set mymail = myol.createItem(0)
mymail.Display

 mymail.bodyformat = 3 'olFormatRichText
'mymail.bodyformat = 2 'olFormatHTML

Set ins = mymail.GetInspector

'WordEditorで、本文編集する
Set doc = ins.WordEditor

Dim rng As Word.Range

'/// 3センテンス作成
doc.Range.InsertAfter " " & vbCrLf
doc.Range.InsertAfter "***" & vbCrLf
doc.Range.InsertAfter " " & vbCrLf

'/// 真ん中のセンテンスを選出
Set rng = doc.Sentences(2)

'貼り付け
'Const wdPasteHTML = 10
rng.PasteSpecial DataType:=10, Placement:=0

Dim marks(2) As String
marks(0) = "ε１ε"
marks(1) = "ε２ε"


Dim files(2) As String

files(0) = "C:\Users\user_name\Desktop\atc_test1.txt"
files(1) = "C:\Users\user_name\Desktop\atc_test2.txt"

Dim sntn As Word.Range
Dim p, mk
For Each p In doc.Paragraphs
    
    Set sntn = p.Range
    
    For mk = 0 To UBound(marks)
        sntn.Find.Execute FindText:=marks(mk)
        
        If sntn.Find.Found Then
            sntn.Text = ""
            If Trim(files(mk)) <> "" Then
                sntn.InsertFile Attachment:=True, Link:=False, Filename:=files(mk)
            End If
        End If
    Next

Next

doc.Range.Font.Name = "ＭＳ Ｐゴシック"
doc.Range.Font.Size = 10.5

'/---------------
mymail.To = "" 'wb.Sheets("_設定").Cells(1, 2).Value
mymail.cc = "" 'wb.Sheets("_設定").Cells(2, 2).Value
mymail.Subject = "" 'wb.Sheets("_設定").Cells(3, 2).Value
'mymail.body = ""
'/---------------

mymail.Recipients.ResolveAll

'/---------------
'''' mymail.send
'/---------------

Set mymail = Nothing
Set myol = Nothing
Set wb = Nothing

End Sub

エクセル側準備

表組みを、以下のように準備して、
ε１ε、ε２εの位置に、添付ファイルを埋め込んでいる
（シート名は「Sheet1」）

参考ページ