向自动 Outlook 邮件添加签名

Question

我正在尝试在发送的自动邮件末尾添加签名。我希望签名成为运行宏的用户的默认签名。我编写的代码运行时不会崩溃，但不会插入签名。我在下面提供代码。

Dim OutApp As Object
Dim OutMail As Object
Dim currentDate As Date
Dim DeliveryDate As String
Dim Recipients As String
Dim CarbonCopy As String
Dim Signature As String

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

currentDate = Format(Date, "dd/mm/yyyy")
Recipients = "a@gmail.com"
CarbonCopy = "b@gmail.com"
Signature = OutMail.body

msg = "<span style='color:black'><p>Dear Team,</p>"

msg = msg & "Thank you in advance</span>"

On Error Resume Next
With OutMail
    .To = Recipients
    .CC = CarbonCopy
    .Subject = "PSR " & currentDate
    .HTMLBody = "<span style = 'color:#1F497D'>" & msg & "</span>" & Signature
    .Attachments.Add ThisWorkbook.FullName
    .Display
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

Answer 1

签名必须声明为变体，您必须先显示空电子邮件才能捕获它。

您的“味精”没有在上面的代码中声明。我假设你已经涵盖了。否则你的代码将无法工作。鉴于这个假设......

Dim OutApp As Object
Dim OutMail As Object
Dim currentDate As Date
Dim DeliveryDate As String
Dim Recipients As String
Dim CarbonCopy As String
Dim Signature As Variant

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

currentDate = Format(Date, "dd/mm/yyyy")
Recipients = "a@gmail.com"
CarbonCopy = "b@gmail.com"
Signature = OutMail.Body

'msg hasn't been defined so it's commented out. msg in the body has been replaced with "msg".
'msg = "<span style='color:black'><p>Dear Team,</p>"

'msg = msg & "Thank you in advance</span>"

On Error Resume Next
With OutMail
    'Capture signature block.
    .Display
    Signature = .HTMLBody
    .To = Recipients
    .CC = CarbonCopy
    .Subject = "PSR " & currentDate
    .HTMLBody = "<span style = 'color:#1F497D'>" & "msg" & "</span>" & Signature
    .Attachments.Add ThisWorkbook.FullName
    .Display
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

Answer 2

我认为您的 mailItem 没有激活。在尝试获取正文之前尝试添加 OutMail.display。那么它应该可以工作了。