如何从Word VBA将现有的签名块插入Outlook .htmlbody

时间:2016-08-10 15:44:40

标签: vba html-email word-vba outlook-vba

我已完成此代码以填充Outlook电子邮件的正文,但是,我不知道如何使用已在Outlook中创建的现有签名块。当我创建新的,回复或转发电子邮件时,我的签名就在那里,但是当我使用此代码创建电子邮件时,它不会出现。我在这里要完成的是将此签名(或任何签名)显示在此代码创建的电子邮件中。

Sample email with desired signature

    Private Sub emailbutton_Click()
    'No-option email sending
    Dim OL              As Object
    Dim EmailItem       As Object
    Dim Doc             As Document

    Application.ScreenUpdating = False
    Set OL = CreateObject("Outlook.Application")
    Set EmailItem = OL.CreateItem(olMailItem)
    Set Doc = ActiveDocument


    If VName.Value = "" Then
        Doc.SaveAs ("Quotation_Blank 2016")
    Else
       Doc.SaveAs2 ("QFORM" & "_" & JNumber.Value & "_" & VName.Value)

    End If


    With EmailItem
        .Subject = "QFORM" & "_" & JNumber.Value & "_" & VName.Value

        'HTMLbody
        msg = "<b><font face=""Times New Roman"" size=""3"" color=""blue"">INTEGRATED ASSEMBLY </font></b><br>" _
        & "   1200 Woodruff Rd.<br>" _
        & "   Suite A12<br>" _
        & "   Greenville, SC 29607<br><br>" _
        & "We have recently released subject project, which will contain assemblies to be outsourced. You have been selected to build these assemblies according to the attachment.<br><br>" _
        & "As part of this process, please review the quotion form attached and inidcate your acceptance. If adjustments and-or corrections are required please feel free to contact us for quick resolution.<br><br>" _
        & "<b><font face=""Times New Roman"" size=""3"" color=""Red"">NOTE: </font></b>" _
        & "The information on attached quotation form is not a contract and only an estimate of predetermined costs per hourly rate for outsource assemblies. <br><br>" _
        & "*******For your records you may wish to print out the completed quote form. <br><br>" _
        & "Thank you, <br><br>" _
        & "<b>HARTNESS INTERNATIONAL </b><br>" _
        & "H1 Production Control" & vbNewLine & Signature


        .HTMLBody = msg

        If VName.Value = "INTEGRATED ASSEMBLY" Then
            .To = "XXX.com;"
            .CC = "XXX.com;" & "XXX.com;"
            .Importance = olImportanceNormal 'Or olImportanceHigh Or         olImportanceLow
            .Attachments.Add Doc.FullName
            .Display
         ElseIf VName.Value = "LEWALLEN" Then
            .To = "XXX.com;"
            .CC = "XXX.com;" & "XXX.com;"
            .Importance = olImportanceNormal 'Or olImportanceHigh Or         olImportanceLow
            .Attachments.Add Doc.FullName
            .Display

         End If
    End With

    Application.ScreenUpdating = True

    Set Doc = Nothing
    Set OL = Nothing
    Set EmailItem = Nothing
End Sub

3 个答案:

答案 0 :(得分:0)

我认为你需要在插入msg后再次调用.HTMLBody。

例如:

.HTMLBody = msg & .HTMLBody

应该获得签名。我没有深入到编程中去了解原因。

答案 1 :(得分:0)

您的模块中是否设置了Option Explicit

我没有看到您在哪里设置签名或宣布它,所以它可能是空的,并没有给您错误信息。

我认为你需要首先通过拉入空白的身体

来检索它

这样的事情应该有用

With EmailItem
   .Display
   signature = .body
   .Subject = "QFORM" & "_" & JNumber.Value & "_" & VName.Value
' and so on ..

`

答案 2 :(得分:0)

代码成功输入with语句以显示EmailItem - 以及在msg之后调用.HTMLBody ..请参阅下面的完整代码。

Private Sub emailbutton_Click()
    'No-option email sending
    Dim OL              As Object
    Dim EmailItem       As Object
    Dim Doc             As Document

    Application.ScreenUpdating = False
    Set OL = CreateObject("Outlook.Application")
    Set EmailItem = OL.CreateItem(olMailItem)
    Set Doc = ActiveDocument

   With EmailItem
    .Display
    End With
        Signature = EmailItem.body


    With EmailItem
        .Subject = "QFORM" & "_" & JNumber.Value & "_" & VName.Value

        'HTMLbody
        msg = "<b><font face=""Times New Roman"" size=""4"" color=""blue"">INTEGRATED ASSEMBLY </font></b><br>" _
        & "   1200 Woodruff Rd.<br>" _
        & "   Suite A12<br>" _
        & "   Greenville, SC 29607<br><br>" _
        & "We have recently released subject project, which will contain assemblies to be outsourced. You have been selected to build these assemblies according to the attachment. <br><br>" _
        & "As part of this process, please review the quotation form attached and indicate your acceptance. If adjustments and-or corrections are required, please feel free to contact us for quick resolution. <br><br>" _
        & "<b><font face=""Times New Roman"" size=""4"" color=""Red"">NOTE: </font></b>" _
        & "The information on attached quotation form is not a contract and only an estimate of predetermined costs per hourly rate for outsource assemblies. <br><br>" _
        & "*******For your records you may wish to print out the completed quote form. <br><br>" _
        & "Thank you, <br><br>" _
        & "<b>HARTNESS INTERNATIONAL </b><br>" _
        & "H1 Production Control <br>" _
        & vbNewLine & Signature

        .HTMLBody = msg & .HTMLBody

        If VName.Value = "INTEGRATED ASSEMBLY" Then
            .To = "ryan@integratedassembly.com;"
            .CC = "jfournier@hartness.com;" & "jmarshone@hartness.com;"
            .Importance = olImportanceNormal 'Or olImportanceHigh Or         olImportanceLow
            .Attachments.Add Doc.FullName
            .Display
         ElseIf VName.Value = "LEWALLEN" Then
            .To = "jessica.andrews@patriot-automation.com;"
            .CC = "jfournier@hartness.com;" & "jmarshone@hartness.com;"
            .Importance = olImportanceNormal 'Or olImportanceHigh Or         olImportanceLow
            .Attachments.Add Doc.FullName
            .Display

         End If
    End With


    If VName.Value = "" Then
        Doc.SaveAs ("Quotation_Blank 2016")
    Else
       Doc.SaveAs2 ("QFORM" & "_" & JNumber.Value & "_" & VName.Value)

    End If

    Application.ScreenUpdating = True

    Set Doc = Nothing
    Set OL = Nothing
    Set EmailItem = Nothing
End Sub