将带图像的签名添加到Mail

Question

我有一个Outlook的宏，我可以用附件创建一个完整的邮件但不能添加保存在我的C盘中的签名（C：\ Users \ JustinG \ AppData \ Roaming \ Microsoft \ Signatures）。

签名类型为.rtf和.htm带图片。

以下是代码：

Sub Mail_Workbook_1()
    Dim OutApp As Object
    Dim Outmail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set Outmail = OutApp.CreateItem(0)

    On Error Resume Next
   ' Change the mail address and subject in the macro before you run it.
    With Outmail

        .SentOnBehalfOfName = "justin.gatlin@rediffmail.com"
        .To = "abc@xyz.com"
        .CC = ""
        .BCC = ""
        .Subject = "Presentation"
        .Body = "Hi Team,"
        .Attachments.add ("C:\Users\DurshetwarA\Desktop\Excel Examination_Master_V1.xlsx")
        .display
        ''SendKeys ("%s")
    End With
    On Error GoTo 0

    Set Outmail = Nothing
    Set OutApp = Nothing
End Sub

Answer 1

在签名目录的.htm文件中，您可以编辑htm文件。图片存储为相对路径，当您使用代码时，它会丢失该路径，因此如果您使用离散路径，它将能够找到图片。所以进入文件并寻找任何相对路径并使它们离散。

“/微软/签名/ picturefile.jpg”

将其更改为包含整个路径

“/ root / user / blah blah ../ Microsoft / Signatures / picturefile.jpg”

这解决了我丢失的图像问题。

Answer 2

而不是.body使用.htmlbody并在HTML中设计您的邮件正文。这是在邮件中插入图像的唯一方法。没有特定选项可以插入签名

Answer 3

解决方案由Ron de Bruin描述here。

Sub Mail_Outlook_With_Signature_Html_2()
' Don't forget to copy the function GetBoiler in the module.
' Working in Office 2000-2013
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim SigString As String
    Dim Signature As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "<H3><B>Dear Customer Ron de Bruin</B></H3>" & _
              "Please visit this website to download the new version.<br>" & _
              "Let me know if you have problems.<br>" & _
              "<A HREF=""http://www.rondebruin.nl/tips.htm"">Ron's Excel Page</A>" & _
              "<br><br><B>Thank you</B>"

    'Change only Mysig.htm to the name of your signature
    SigString = Environ("appdata") & _
                "\Microsoft\Signatures\Mysig.htm"

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

    On Error Resume Next

    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .HTMLBody = strbody & "<br>" & Signature
        .Send    'or use .Display
    End With

    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = 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