发送带有签名图像 Outlook 2016 VBA 的电子邮件

Question

我已按照教程使用提醒和日历约会发送自动电子邮件。
“基地”来自https://www.extendoffice.com/documents/outlook/1567-outlook-send-schedule-recurring-email.html
问题在于签名中的图像变成了 html 标签。
Ron de Bruin 的代码在这里：https://www.rondebruin.nl/win/s1/outlook/signature.htm 可以在 html 中添加签名，它几乎可以工作。

我得到正确的文本、字体、颜色和链接，但图像是带有红色 x 的空框。
我查看了消息的来源，似乎签名的代码抓取了硬编码的相对 img 来源。
所以我尝试添加“替换”代码以将消息中的源编辑为绝对路径。
它奏效了！但只在我的电脑上。 图像没有添加，它们只是链接到。

任何有解决方案的人如何添加（或附加）图像以使签名看起来正确？

Private Sub Application_Reminder(ByVal item As Object)
    Dim MItem As MailItem
    Set MItem = Application.CreateItem(olMailItem)

    If item.MessageClass <> "IPM.Appointment" Then
        Exit Sub
    End If
    If item.Categories <> "Beställa material mail" Then ' make sure it's correct category
        Exit Sub
    End If

    If Now > item.End + 6 / 24 Then ' if the appointment time was when computer was off (or long delay) don't email.
        MsgBox item.Subject & " är inte skickat för att det är för sent." ' "subject" is not send because it's too late.
        Exit Sub
    End If

    'Below is from https://www.rondebruin.nl/win/s1/outlook/signature.htm
    SigString = Environ("appdata") & "\Microsoft\Signatures\Axfood.htm"

    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If

    'replace incorrect img sources.
    Signature = Replace(Signature, "src=" & Chr(34) & "Axfood-filer/image", "src=" & Chr(34) & Environ("appdata") & "/Microsoft/Signatures/Axfood-filer/image")

    ' send email
    MItem.To = item.Location
    MItem.Subject = item.Subject
    MItem.HTMLBody = item.Body & Signature
    MItem.Send
    Set MItem = Nothing
End Sub


Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function

编辑；

Outlook 签名文件中的示例 img 源：
<img border=0 width=21 height=21 src="Axfood-filer/image010.jpg" v:shapes="_x0000_i1030">

这是使用代码中的替换功能编辑到硬盘驱动器上的绝对路径。

签名文件可以在：C:\Users\<USER>\AppData\Roaming\Microsoft\Signatures

Answer 1

我找到了适用于 Outlook 2016 的答案，并在 Android/iPhone 上给出了“OK”结果。

我通过 vba 附加图像并用 html 代码内联它们。

Dim oAttach As Outlook.Attachment
Dim colAttach As Outlook.Attachments

Set colAttach = MItem.Attachments

' attach the images to the email
Set oAttach = colAttach.Add(Environ("appdata") & "/Microsoft/Signatures/Axfood-filer/image001.png")
Set oAttach = colAttach.Add(Environ("appdata") & "/Microsoft/Signatures/Axfood-filer/image003.jpg")
Set oAttach = colAttach.Add(Environ("appdata") & "/Microsoft/Signatures/Axfood-filer/image005.jpg")
Set oAttach = colAttach.Add(Environ("appdata") & "/Microsoft/Signatures/Axfood-filer/image007.jpg")
Set oAttach = colAttach.Add(Environ("appdata") & "/Microsoft/Signatures/Axfood-filer/image009.jpg")

'add the images to signature string with html formatting.
Signature = Signature & "<a href='http://www.axfood.se'><IMG alt='' hspace=0 src='cid:image001.png' align=baseline width=151 border=0></a><br><br>"
Signature = Signature & "<a href='https://www.facebook.com/axfoodkoncernen/'><IMG alt='' hspace=0 src='cid:image003.jpg' align=baseline border=0></a> "
Signature = Signature & "<a href='https://twitter.com/axfood'><IMG alt='' hspace=0 src='cid:image005.jpg' align=baseline border=0></a> "
Signature = Signature & "<a href='https://www.linkedin.com/company/axfood'><IMG alt='' hspace=0 src='cid:image007.jpg' align=baseline border=0></a> "
Signature = Signature & "<a href='https://www.instagram.com/axfoodkoncernen/'><IMG alt='' hspace=0 src='cid:image009.jpg' align=baseline border=0></a> "

结果是 Outlook 的电子邮件正确。
在 Android 上，图像是附加的，但不是内联在电子邮件中。
在 iPhone 上，图像在电子邮件中内联，但链接不跨越图像。

iPhone 示例：
链接链接链接链接
图片 图片 图片 图片

而不是图像作为实际链接。