Excel VBAでメールに画像を挿入してOutLookで送信する方法

Excel VBAでメールに画像を挿入してOutLookで送信するコードを書きました。
HTMLメールの本文にQRコードなどを挿入したいときに使用できます。
画像ファイルをBase64でエンコードして、HTMLに埋め込むことで実現できます。

以下は、画像ファイルのパスを指定して読み込んでメールの本文にHTMLタグをセットして、下書きに保存するコードです。

Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)


With objMail



    Set .SendUsingAccount = objOutlook.Session.Accounts.Item("\[送信元メールアドレス\]")

    .Subject = "\[メールの件名\]"

   
   '画像ファイルをBase64でエンコードする
    Dim objBase64 As Object
    Dim strBase64 As String
    Dim sImageFilePath As String
    sImageFilePath = "\[画像ファイルのパス\]"
    
    Dim sImageTag As String
    
    Set objBase64 = CreateObject("MSXML2.DOMDocument").createElement("base64")
    With CreateObject("ADODB.Stream")
    
        .Type = 1
        
        .Open
        
        .LoadFromFile sImageFilePath
        
        objBase64.DataType = "bin.base64"
        
        objBase64.nodeTypedValue = .Read(-1)
        
        strBase64 = objBase64.Text
        
        .Close
    
    End With
    
    'これが画像ファイルのHTMLタグになります
    sImageTag = "<img src=""data:image/jpeg;base64," & strBase64 & """ />"""
    
    '今回は画像だけをメールの本文としました
    .HTMLBody = sImageTag

    .To = "\[送信先メールアドレス\]"
    
    .Close (0) '下書きに保存する　送信する場合は、.Send
    

End With