Outlook VBAでテンプレートから作成した返信メールに図形が表示されない。

Question

Outlook VBAでテンプレートから作成した返信メールに図形が表示されない。
どの様にすれば図形が表示されるようになるでしょうか。

Sub メール返信()

'Outlook用の定義
    Dim objSelect As Outlook.Selection
    Dim objIns As Inspector
    Dim objItem As Object
    Dim objItem2 As Object

    Set objIns = Application.ActiveInspector
    Set objSelect = Outlook.Application.ActiveExplorer.Selection
    Set objItem = objSelect.Item(1)
    Set objItem2 = _
    CreateItemFromTemplate("C:\Users\user1\AppData\Roaming\Microsoft\Templates\template1.oft")
       
    Set objReItem = objItem.ReplyAll
    
    With objReItem        
        .BodyFormat = 2 
        .Body = objItem2.Body  & objReItem.Body
        .Recipients.ResolveAll
        .Display 'メールを表示します。
    End With

'オブジェクトを解放します。
Set objReItem = Nothing

End Sub

Comments

[ken3memo]

With objReItem
.BodyFormat = 2

https://docs.microsoft.com/ja-jp/office/vba/api/outlook.olbodyformat
アイテム本文の形式を指定します。
OLBODYFORMAT 列挙 (OUTLOOK)
名前 値 説明
olFormatHTML 2 HTML 形式

.Body = objItem2.Body & objReItem.Body
でテンプレート(objItem2)本文.Bodyを代入していますが、

ア. objItem2 の .BodyFormat は 指定しなくてもいいの？
Set objItem2 = _
CreateItemFromTemplate("C:\Users\user1\AppData\Roaming\Microsoft\Templates\template1.oft")
で作成すると、どの.BodyFormat？.BodyFormatを変更すると変換されるから触らなくてそのままでいいのかな

イ. .htmlbody なんてプロパティもあるので、参考となれば
https://docs.microsoft.com/ja-jp/office/vba/api/outlook.mailitem.htmlbody

[km0815.lj]

ご返信遅くなり申し訳ございません。

ア.すみません。初心者の為、そのままで良いのかも分かりません。
また、どのように指定して良いのかも分かりません。
指定方法をご教示頂けないでしょうか。
イ.参考にしましたが、html文が長く直接記述出来ないので、テンプレートにしました。

Answer 1

図形が埋め込まれたHTML本文を図形ごとコピーするという場合、BodyやHTMLBodyなどでは正常に動作しません。
何故なら、HTMLに埋め込まれた画像は実際には添付ファイルとして存在しますが、通常の方法で添付ファイルをコピーしても埋め込み画像と認識されないためです。
このあたりの詳細を説明すると大変なので、どうやったらコピーできるかだけ説明します。

Outlookの本文を編集する際には内部的にWordの機能が使われており、Outlookの本文はWordのオブジェクトモデルを使って編集できます。
例えば、objReItemのメール本文の先頭にobjItem2の本文を図形を保ってコピーするという処理は以下のようになります。

    Dim docItem2 As Object
    Dim docReItem As Object
    
    objItem2.Display
    Set docItem2 = objItem2.GetInspector().WordEditor
    docItem2.Content.Select
    docItem2.Parent.Selection.Copy
    
    objReItem.Display
    Set docReItem = objReItem.GetInspector().WordEditor
    docReItem.Range(0, 0).Select
    docReItem.Parent.Selection.Paste

Comments

[km0815.lj]

ご返信遅くなり申し訳ございません。

ご回答ありがとうございます。

図形も表示されるようになりました。

実行結果から初心者ながらなんとなく動きが分かりました。
ただ、以下の様に変更したところ、下書きメールが２つ(１つは新規、１つは返信用)ができました。
新規メールの分は削除すれば良いという認識であっていますでしょうか。

それとも、追記する場所が違う等、誤っているところがありますでしょうか。
質問ばかりで申し訳ございませんが、宜しくお願い致します。

Dim objSelect As Outlook.Selection
Dim objIns As Inspector
Dim objItem As Object
Dim objItem2 As Object
Dim docItem2 As Object　'追記
Dim docReItem As Object '追記

Set objIns = Application.ActiveInspector
Set objSelect = Outlook.Application.ActiveExplorer.Selection
Set objItem = objSelect.Item(1)
Set objItem2 = _
CreateItemFromTemplate("C:\Users\user1\AppData\Roaming\Microsoft\Templates\template1.oft")

Set objReItem = objItem.ReplyAll

　'以下、ご教示頂いた部分の追記
objItem2.Display
Set docItem2 = objItem2.GetInspector().WordEditor
docItem2.Content.Select
docItem2.Parent.Selection.Copy

objReItem.Display
Set docReItem = objReItem.GetInspector().WordEditor
docReItem.Range(0, 0).Select
docReItem.Parent.Selection.Paste

[millefeuille]

テンプレートの本文をコピーするために作成したメール(objItem2)は削除してかまいませんので、以下の1行を最後に追加してください。

objItem2.Close olDiscard

[km0815.lj]

ご返信ありがとうございます。