outlookのhtml形式のテンプレートの、宛先と本文の文言を置換するExcelマクロ

前提・実現したいこと

outlookのhtml形式のメールテンプレート(.otf)に、
エクセルでリスト化している情報（To・CC・BCC・会社名・送り先氏名）を置換して埋め込み、
一括でメールの下書きを作成するマクロを作りたいと思っています。

発生している問題・エラーメッセージ

エクセルでリスト化している宛先・本文の一部の置換はできたのですが、
メールがhtml形式ではなくテキスト形式になってしまいます。
（改行はされているが、フォント設定などが消え、画像やリンクが全てURL表示になっている状態）

Outlookを起動するVBAコード

Sub HTMLメール一括作成()
    
    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 = Range("添付ファイルのパスを指定しているセル")    '添付1
    Tenp2 = Range("添付ファイルのパスを指定しているセル")    '添付2
    R_Start = Range("送付先開始セル") + 7    '送付先リスト開始番号
    R_End = Range("送付先終了セル") + 7    '送付先リスト終了番号
    
    For R_Start = R_Start To R_End
        Set MI = CreateItemFromTemplate(Worksheets("使用するテンプレート.oft")
        
        MI.Subject = Range("件名のセルを指定")    '件名
        MI.To = Cells(R_Start, "Toの列を指定")    'TO
        MI.Cc = Cells(R_Start, "Ccの列を指定")    'CC
        MI.Bcc = Cells(R_Start, "Bccの列を指定")    'BCC

        '添付ファイルがある場合は添付させる
        If Tenp1 <> "" Then
            MI.Attachments.Add Tenp1
        End If
        If Tenp2 <> "" Then
            MI.Attachments.Add Tenp2
        End If

    'メール本文の会社名と送付先氏名をエクセルのリストに置換        
    MI.Body = Replace(MI.Body, "★会社名★", Cells(R_Start, "会社名の入った列"))
    MI.Body = Replace(MI.Body, "★宛先★", Cells(R_Start, "送付先氏名の入った列"))
        
        MI.Display    'メール表示
    Next
    
    Set OL = Nothing
    Set MI = Nothing
    
    MsgBox "メールが正常に作成できました。"
End Sub

試したこと

・「MI.Body」を「MI.HTMLBody」に変更してみましたが、改行が全て消えてしまい、画像・リンクも表示されません
・メールを作成した際、メール上部のバーには「件名 - メッセージ（HTML形式）とは表示されています。

補足情報（FW/ツールのバージョンなど）

Outlook・エクセルどちらもバージョンは1808です。

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

回答1件

MI.HTMLBodyに設定する内容は、単なるテキストではなく、HTML形式のソースです。
改行は<br>タグが必要ですし、画像は<img>タグ、リンクは<a>タグが必要ですが、その点は大丈夫でしょうか？

投稿2020/06/26 08:49

kenshirou

総合スコア772

Chihiro110

2020/06/29 00:28

お返事が遅くなり申し訳ありません。元のメールテンプレートには、HTMLソースの記入があります。 Replaceの後ろのMI.BodyにHTMLと記入するのを忘れていたので、下記のように試してみたところ、本文のHTMLはきちんと出るのですが、今度は会社名・宛名のReplaceができなくなってしまいました… 'メール本文の会社名と送付先氏名をエクセルのリストに置換 MI.HTMLBody = Replace(MI.HTMLBody, "★会社名★", Cells(R_Start, "会社名の入った列")) MI.HTMLBody = Replace(MI.HTMLBody, "★宛先★", Cells(R_Start, "送付先氏名の入った列"))

kenshirou

2020/06/29 01:04 編集

ReplaceまえのMI.HTMLBodyの内容はどうなっているでしょうか？これを見れば、例えば、"★会社名★"とある所がそのまま置換できなくなっている原因が分かるのではないかと思います（例えば、意図しないタグが★の所に挿入されている、等）。あと、MI.HTMLBodyの内容は変数に受けた方がよいです。具体的には、この変数の内容を加工して、最終的に加工した内容をMI.HTMLBodyにセットするようにします。これは、以下の理由によります。・変数のReplace等の加工がちゃんとなされているかを確認しやすい。・何度もMI.HTMLBodyにアクセスするのは負担がかかるから。

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