如何在用于从 outlook 发送邮件的宏中显示签名?

How to display signature in macro used for sending mail from outlook?

目前我创建了一个宏,其中包含一些内容作为正文,之后我想显示 outlook 用户的默认签名。

我在 excel 中有两个按钮和两个宏,每个一个。

.Display 是我认为负责签名显示的,但是当我使用它时,签名不会出现在第一个宏中,而在第二个功能中它会出现但是

身顶也。 请指教该怎么做。 下面是我的宏:-

    Sub email()         
    Dim OlApp As Object
    Set OlApp = CreateObject("Outlook.Application")
    Dim myNameSp As Object
     'Set myNameSp = CreateObject("Outlook.Namespace")
    Dim myInbox As Object
     'Set myInbox = CreateObject("Outlook.MAPIFolder")
    Dim myExplorer As Object
     'Set myExplorer = CreateObject("Outlook.Explore")
    Dim NewMail As Object
     'Set NewMail = CreateObject("Outlook.MailItem")
    Dim OutOpen As Boolean
    Dim nameList  As String
    Dim lastRow As Integer
    Dim CCLISt As String
    Dim Result As Integer
    Dim ResultTo As Integer
    Dim ResultCC As Integer
    Dim CCLISTAppned As String


    'count last working row
    With ActiveSheet
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
   Dim i As Integer

     For i = 11 To lastRow 'use cells 7 to 39 in column "I" where names are stored
     If Sheets("Sheet1").Range("A" & i).Value = "Y" Then
      If Sheets("Sheet1").Range("H" & i).Value <> "" Then
      ResultTo = InStr(nameList, Sheets("Sheet1").Range("H" & i).Value)
       If (ResultTo = 0) Then
        nameList = nameList & ";" & Sheets("Sheet1").Range("H" & i).Value
        End If
       Result = InStr(CCLISt, Sheets("Sheet1").Range("L" & i).Value)
       If (Result = 0) Then
        CCLISt = CCLISt & ";" & Sheets("Sheet1").Range("L" & i).Value
        End If
         ResultCC = InStr(CCLISTAppned, Sheets("Sheet1").Range("N" & i).Value)
       If (ResultCC = 0) Then
        CCLISTAppned = CCLISTAppned & ";" & Sheets("Sheet1").Range("N" & i).Value
        End If

        End If
    End If

      Next
      CCLISt = CCLISt & CCLISTAppned
        ' Check to see if there's an explorer window open
        ' If not then open up a new one
        OutOpen = True
        Set myExplorer = OlApp.ActiveExplorer
        If TypeName(myExplorer) = "Nothing" Then
            OutOpen = False
            Set myNameSp = OlApp.GetNamespace("MAPI")
            'Set myInbox = myNameSp.GetDefaultFolder(olFolderInbox)
           ' Set myExplorer = myInbox.GetExplorer
        End If

        ' If you  don't to display your outlook while sending email then comment the below statement
        'otherwise you can un-comment

        'myExplorer.Display

        ' Create a new mail message item.
        Set NewMail = OlApp.CreateItem(0)
        With NewMail
            '.Display ' You don't have to show the e-mail to send it
             .Display
            .Subject = "Audit Response Requested - ["
            .Subject = .Subject & Sheets("Sheet1").Range("E2").Value & "/"
            .Subject = .Subject & Sheets("Sheet1").Range("E1").Value & "]"

            .To = nameList
            .CC = CCLISt

            .HTMLBody = "<b><h2 style=color:blue; background-color:yellow><p style=background: yellow><center>Please use voting buttons above to facilitate your reply. </center></p></h2></b>"
            .HTMLBody = .HTMLBody & "We have been asked by <b>" & Sheets("Sheet1").Range("E2").Value & "</b>, to furnish information in conjunction with their annual financial audit. "
            .HTMLBody = .HTMLBody & "According to the Firm's records, you have recorded time on matters for the Company [<b> [and/or its subsidiaries]</b> since their last annual audit. "
            .HTMLBody = .HTMLBody & "[<b> Our last letter (and its Exhibit A) is printed out below. </b>] Accordingly, please respond as to "
            .HTMLBody = .HTMLBody & "whether or not you have anything material to report. " & "<b>[Please send [email sender] if you have questions about any materiality thresholds.] [Our response is due [date]].</b>" & "  Thank you!"
            .HTMLBody = .HTMLBody & "<br><br>" & "For your information:" & "<br><br>"
            .HTMLBody = .HTMLBody & "1.&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Are you aware of any (1) pending litigation, or (2) overtly threatened litigation, meaning that a potential claimant has manifested to the Company an awareness of and present intention to assert a possible claim or assessment?"
            .HTMLBody = .HTMLBody & "<br>" & "2.&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Are you aware of or have you worked on any matter for the Company which may involve an unasserted possible claim or assessment that may call for financial statement disclosure? Financial statement disclosure of material unasserted claims or assessments may be required in the following cases:"
            .HTMLBody = .HTMLBody & "<br>" & "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp(a)&nbsp;&nbsp;&nbsp;where there has been a manifestation by a potential claimant of an awareness of a possible claim or assessment and there is a reasonable possibility that the outcome will be unfavorable, or  "
            .HTMLBody = .HTMLBody & "<br>" & "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp(b)&nbsp;&nbsp;&nbsp;where there has been no manifestation by a potential claimant of an awareness of a possible claim or assessment but it is considered probable that a claim will be asserted and there is a reasonable possibility that the outcome will be unfavorable.  Examples of this include the following: "
            .HTMLBody = .HTMLBody & "<br>" & "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp&nbsp;(i) a catastrophe, accident, or other similar physical occurrence in which the client's involvement is open and notorious, or"
            .HTMLBody = .HTMLBody & "<br>" & "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp(ii) an investigation by a government agency where enforcement proceedings have been instituted or where the likelihood that they will not be instituted is remote, under circumstances where assertion of one or more private claims for redress would normally be expected, or"
            .HTMLBody = .HTMLBody & "<br>" & "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp(iii) a public disclosure by the client acknowledging (and thus focusing attention upon) the existence of one or more probable claims arising out of an event or circumstance"
            .HTMLBody = .HTMLBody & "<br>" & "3.&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Have you during the period in question called to the client's attention any matters you thought the client should consider for financial statement disclosure? <b/>"
            .HTMLBody = .HTMLBody & "<br>" & "<b>[4.&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Are you aware of any material litigation, claims or assessments relating to the Company that have been settled?]"
            .HTMLBody = .HTMLBody & "<br>" & "<b>=============================<b/>" & "<br>" & "<b>Last [Annual] Audit Letter dated [***]<b/>"

        .VotingOptions = "NOTHING TO REPORT;Yes - Please choose edit to explain in email Reply;"

        End With

        'NewMail.Send
        'If Not OutOpen Then OlApp.Quit

        'Release memory.
        Set OlApp = Nothing
        Set myNameSp = Nothing
        Set myInbox = Nothing
        Set myExplorer = Nothing
        Set NewMail = Nothing


End Sub


Sub Reminder()

   Dim OlApp As Object
    Set OlApp = CreateObject("Outlook.Application")
    Dim myNameSp As Object
     'Set myNameSp = CreateObject("Outlook.Namespace")
    Dim myInbox As Object
     'Set myInbox = CreateObject("Outlook.MAPIFolder")
    Dim myExplorer As Object
     'Set myExplorer = CreateObject("Outlook.Explore")
    Dim NewMail As Object
     'Set NewMail = CreateObject("Outlook.MailItem")
    Dim OutOpen As Boolean
    Dim nameList  As String
    Dim lastRow As Integer
    Dim CCLISt As String
    Dim Result As Integer
    Dim ResultTo As Integer
    Dim ResultCC As Integer
    Dim CCLISTAppned As String



    'count last working row
    With ActiveSheet
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
   Dim i As Integer
     For i = 11 To lastRow 'use cells 7 to 39 in column "I" where names are stored
     If Sheets("Sheet1").Range("B" & i).Value = "" And Sheets("Sheet1").Range("A" & i).Value = "Y" Then
      If Sheets("Sheet1").Range("H" & i).Value <> "" Then
      ResultTo = InStr(nameList, Sheets("Sheet1").Range("H" & i).Value)
       If (ResultTo = 0) Then
        nameList = nameList & ";" & Sheets("Sheet1").Range("H" & i).Value
        End If
       Result = InStr(CCLISt, Sheets("Sheet1").Range("L" & i).Value)
       If (Result = 0) Then
        CCLISt = CCLISt & ";" & Sheets("Sheet1").Range("L" & i).Value
        End If
         ResultCC = InStr(CCLISTAppned, Sheets("Sheet1").Range("N" & i).Value)
       If (ResultCC = 0) Then
        CCLISTAppned = CCLISTAppned & ";" & Sheets("Sheet1").Range("N" & i).Value
        End If

        End If
    End If

      Next
      CCLISt = CCLISt & CCLISTAppned
        ' Check to see if there's an explorer window open
        ' If not then open up a new one
        OutOpen = True
        Set myExplorer = OlApp.ActiveExplorer
        If TypeName(myExplorer) = "Nothing" Then
            OutOpen = False
            Set myNameSp = OlApp.GetNamespace("MAPI")
           ' Set myInbox = myNameSp.GetDefaultFolder(olFolderInbox)
            'Set myExplorer = myInbox.GetExplorer
        End If

        ' If you  don't to display your outlook while sending email then comment the below statement
        'otherwise you can un-comment

        'myExplorer.Display

        ' Create a new mail message item.
        Set NewMail = OlApp.CreateItem(0)
        With NewMail
            '.Display ' You don't have to show the e-mail to send it

            .Subject = "Audit Response Requested - ["
            .Subject = .Subject & Sheets("Sheet1").Range("E2").Value & "/"
            .Subject = .Subject & Sheets("Sheet1").Range("E1").Value & "]"

            .To = nameList
            .CC = CCLISt
            .HTMLBody = .HTMLBody & "This is a quick reminder that our response for " & Sheets("Sheet1").Range("E2").Value & " is due. Please respond to below as soon as you are able. Thanks!"
            .HTMLBody = .HTMLBody & "<b><h2 style=color:blue background: #FFFF00><p style=background: yellow><center>Please use voting buttons above to facilitate your reply. </center></p></h2></b>"
            .HTMLBody = .HTMLBody & "We have been asked by <b>" & Sheets("Sheet1").Range("E2").Value & "</b>, to furnish information in conjunction with their annual financial audit. "
            .HTMLBody = .HTMLBody & "According to the Firm's records, you have recorded time on matters for the Company [<b> [and/or its subsidiaries]</b> since their last annual audit. "
            .HTMLBody = .HTMLBody & "[<b> Our last letter (and its Exhibit A) is printed out below. </b>] Accordingly, please respond as to "
            .HTMLBody = .HTMLBody & "whether or not you have anything material to report. " & "<b>[Please send [email sender] if you have questions about any materiality thresholds.] [Our response is due [date]].</b>" & "Thank you!"
            .HTMLBody = .HTMLBody & "<br><br>" & "For your information:" & "<br><br>"
            .HTMLBody = .HTMLBody & "1.&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Are you aware of any (1) pending litigation, or (2) overtly threatened litigation, meaning that a potential claimant has manifested to the Company an awareness of and present intention to assert a possible claim or assessment?"
            .HTMLBody = .HTMLBody & "<br>" & "2.&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Are you aware of or have you worked on any matter for the Company which may involve an unasserted possible claim or assessment that may call for financial statement disclosure? Financial statement disclosure of material unasserted claims or assessments may be required in the following cases:"
            .HTMLBody = .HTMLBody & "<br>" & "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp(a)&nbsp;&nbsp;&nbsp;where there has been a manifestation by a potential claimant of an awareness of a possible claim or assessment and there is a reasonable possibility that the outcome will be unfavorable, or  "
            .HTMLBody = .HTMLBody & "<br>" & "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp(b)&nbsp;&nbsp;&nbsp;where there has been no manifestation by a potential claimant of an awareness of a possible claim or assessment but it is considered probable that a claim will be asserted and there is a reasonable possibility that the outcome will be unfavorable.  Examples of this include the following: "
            .HTMLBody = .HTMLBody & "<br>" & "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp&nbsp;(i) a catastrophe, accident, or other similar physical occurrence in which the client's involvement is open and notorious, or"
            .HTMLBody = .HTMLBody & "<br>" & "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp(ii) an investigation by a government agency where enforcement proceedings have been instituted or where the likelihood that they will not be instituted is remote, under circumstances where assertion of one or more private claims for redress would normally be expected, or"
            .HTMLBody = .HTMLBody & "<br>" & "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp(iii) a public disclosure by the client acknowledging (and thus focusing attention upon) the existence of one or more probable claims arising out of an event or circumstance"
            .HTMLBody = .HTMLBody & "<br>" & "3.&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Have you during the period in question called to the client's attention any matters you thought the client should consider for financial statement disclosure? <b/>"
            .HTMLBody = .HTMLBody & "<br>" & "<b>[4.&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Are you aware of any material litigation, claims or assessments relating to the Company that have been settled?]"
            .HTMLBody = .HTMLBody & "<br>" & "<b>=============================<b/>" & "<br>" & "<b>Last [Annual] Audit Letter dated [***]<b/>"
             .Display
        .VotingOptions = "NOTHING TO REPORT;Yes - Please choose edit to explain in email Reply;"

        End With

        'NewMail.Send
        'If Not OutOpen Then OlApp.Quit

        'Release memory.
        Set OlApp = Nothing
        Set myNameSp = Nothing
        Set myInbox = Nothing
        Set myExplorer = Nothing
        Set NewMail = Nothing


End Sub

尝试在 Set NewMail = OlApp.CreateItem(0)

旁边添加以下行
' Create a new mail message item.
Dim Signature As String
Set NewMail = olApp.CreateItem(0)
Signature = NewMail.HTMLBody
With NewMail
    '.Display ' You don't have to show the e-mail to send it
     .Display
    .Subject = "Audit Response Requested - ["
    .HTMLBody = .HTMLBody & vbNewLine & Signature
    .To = nameList
    .CC = CCLISt

Outlook 对象模型不提供任何签名。但是您可以使用 VBA 宏在运行时编辑消息正文。

Outlook 对象模型为工作项正文提供了三种主要方式:

  1. Body - 表示 Outlook 项目的明文正文的字符串。
  2. HTMLBody - 表示指定项目的 HTML 正文的字符串。
  3. Word editor - 正在显示的消息的 Microsoft Word 文档对象模型。 Inspector 的 WordEditor 属性 class returns 来自 Word 对象模型的文档 class 实例,您可以使用它来设置邮件正文。

您可以在 Chapter 17: Working with Item Bodies 中阅读有关所有这些方式的更多信息。选择哪种方式自定义消息正文中的签名,由您决定。

请注意,当您使用 HTMLBody 属性 时,您需要在结束 </body> 标签之前添加签名内容(格式正确的 HTML 标记) ,而不仅仅是附加 HTMLBody 字符串。因此,在 HTML 正文字符串中找到结束正文标记并在其中插入您的签名。

这显示了如何使用 Omar 的回答中使用的方法获取签名。

Sub email_Signature_Demo()

    ' Run this demo code in Outlook
    With CreateItem(0)

        MsgBox ".HTMLBody is not the signature." & vbCr & vbCr & .HTMLBody
        .Display ' This is required at the start, not the end
        MsgBox ".HTMLBody is the signature " & vbCr & vbCr & .HTMLBody

        .HTMLBody = "According to the Firm's records... " & .HTMLBody

    End With

End Sub