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

EDIT;

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

使用代码中的replace函数编辑到硬盘驱动器上的绝对路径。

签名文件可以在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示例：
链接链接链接
图像图像图像

而不是影像实际链接。

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

1 个答案: