在VBA中,如何在没有直接路径的情况下发送带有签名和图像的电子邮件?

时间:2016-07-19 13:18:29

标签: excel vba email

我希望发送一封包含一系列excel文档的电子邮件,其中包含发件人的默认签名(包含图片)。我正在使用似乎是方法,如下所示。最初,我无法在不更改.htm文件的图像src的情况下显示电子邮件,以直接链接到相关图像。这非常有效,但问题是我需要一个不需要直接路径的解决方案。在工作中,我们的计算机将在启动时更新签名文件夹,并覆盖我对其所做的任何更改。我必须使这个程序适用于任何工作计算机,所以我无法专门更改每个img src路径。如果有人知道允许在没有直接路径或任何其他解决方法的情况下访问完整签名的方法,我将不胜感激。谢谢。

.htm文件代表签名并引用其中的图像源。它有点像<img border=0 width=240 height=148 src="MYCOMPANY%20Signature_files/image001.png" v:shapes="Picture_x0020_1"></span><![endif]></span></a><span style='font-size:8.0pt;mso-bidi-font-size:11.0pt;font-family:"Arial",sans-serif; color:#A1A0A4'>。我能够将src =直接更改为计算机上图像的路径,但由于这被覆盖,我无法将其用作解决方案。

    Dim OutApp As Object
    Dim OutMail As Object
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    a = customerContact
    b = salesExec
    Dim Ebody As String
    Ebody = "placeholder"
    Ebody = Cells(3, 2) & "<br>" _
    & "<br>" _
    & "Dear, " & customerFirstName & "<br>" _
    & "<br>" _
    & Cells(7, 2) & "<br>" _
    & "<br>" _
    & Cells(9, 2) & "<br>" _
    & "<br>" _
    & Cells(11, 2) & "<br>" _
    & "<br>" _
    & Cells(13, 2)
    Signature = Environ("appdata") & "\Microsoft\Signatures\"
    If Dir(Signature, vbDirectory) <> vbNullString Then
        Signature = Signature & Dir$(Signature & "*.htm")
    Else:
        Signature = ""
    End If

    Signature = CreateObject("Scripting.FileSystemObject").GetFile(Signature).OpenAsTextStream(1, -2).ReadAll

    On Error Resume Next
    With OutMail
            .To = customerContact
            .CC = ""
            .BCC = salesExec
            .Subject = "Welcome"
             ' In place of the following statement, you can use ".Display" to
             ' display the e-mail message.
            'or if you dont want it to auto send.....change  .send  to .display
            .HTMLBody = "<body style='font-family:calibri;font-size:11pt'>" _
            & Ebody _
            & "<br>" _
            & "<br>" & Signature
            .display
    End With
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing

2 个答案:

答案 0 :(得分:1)

我找到了一个似乎没问题的解决方案。我没有编辑.htm文件,而是从.htm路径中提取图像并将其粘贴到.HTML主体上。

您可以根据需要移动签名和图像,我只是想确保它首先工作。

本质上,修改仅适用于代码的With OutMail部分,它看起来像这样(但我删除了公司相关的东西):

With OutMail
            .To = customerContact
            .CC = ""
            .BCC = salesExec
            .Subject = "Welcome"
             ' In place of the following statement, you can use ".Display" to
             ' display the e-mail message.
            'or if you dont want it to auto send.....change  .send  to .display
            .HTMLBody = "<body style='font-family:calibri;font-size:11pt'>" _
            & Ebody _
            & "<br>" _
            & "<img src='c:\Users\<YOUR USERNAME>\AppData\Roaming\Microsoft\Signatures\<SIGNATURE FILES FOLDER>\image001.png'>" _
            & "<br>" & Signature
            .display
    End With

答案 1 :(得分:1)

好的,所以我认为这应该可以解析HTML并在运行时操作它,但这给我带来了比我预期的麻烦,但如果我理解正确,你只需要默认插入签名,我认为你正在做的事情导致了一个问题,因为你在Outlook能够做到这一点之前操纵.HTMLBody。如果在编辑MailItem.Display之前调用MailItem.GetInspectorHTMLBody ,Outlook将添加用户的默认签名。

这是一个简单的例子:

Sub foo()
Dim Signature$
Dim olApp As Object
Dim olMail As Object
Set olApp = GetObject(, "Outlook.Application")
Set olMail = olApp.CreateItem(0)

olMail.GetInspector
Signature = olMail.HTMLBody
olMail.HTMLBody = "<body style='font-family:calibri;font-size:11pt'>blah blah blah" _
            & "<br>" _
            & "<br>" & Signature

olMail.display  '## Verify you can see the signature

End Sub

试试这个。我的想法是调用.GetInspector(应该正确插入签名),然后捕获Signature = .HTMLBody(稍后附加到电子邮件的末尾),添加自定义HTML,然后附加{ {1}}。

Signature

工作原理:

  

当您调用With OutMail .GetInspector ' ## This inserts default signature Signature = .HTMLBody ' ## Capture the signature HTML .To = customerContact .CC = "" .BCC = salesExec .Subject = "Welcome" ' In place of the following statement, you can use ".Display" to ' display the e-mail message. 'or if you dont want it to auto send.....change .send to .display .HTMLBody = "<body style='font-family:calibri;font-size:11pt'>" _ & Ebody _ & "<br>" _ & Signature .display End With (导致消息显示在屏幕上)或访问{{}时,Outlook会将签名添加到新的未修改消息(您不应在此之前修改正文) 1}}属性

完整代码可以省略您之前与MailItem.Display和FSO等的一些交易。

MailItem.GetInspector