电子邮件签名未在Outlook中显示
Posted
tags:
篇首语：本文由小常识网(cha138.com)小编为大家整理，主要介绍了电子邮件签名未在Outlook中显示相关的知识，希望对你有一定的参考价值。
我已经搜索了Ron De Bruin的网站和SO，无法找到为什么在我从Excel生成的电子邮件中没有显示电子邮件签名的原因，因为.htmlBody = TableInfo(TitleCo, clsDate, ContractPrice, lAmount, lnProd, Notes) & "<br><br>" & vbNewLine & .HTMLBody中使用的格式与我搜索的内容完全匹配。我需要另一只眼睛。以下是生成电子邮件的功能和子内容。我确定自己缺少一些非常简单的内容，但我看不到它。如果我需要在Worksheet_Change事件中发布代码，请告诉我。
Option Explicit
Public Const TBodyMarker As String = "@tbody"
Sub CreateEmail(ByVal CustName As String, ByVal TitleCo As String, ByVal clsDate As String, _
ByVal ContractPrice As String, ByVal lAmount As String, ByVal lnProd As String, _
ByVal Notes As String)
Dim pEmail As String
pEmail = "ZackE@VBARules.coding"
Dim Outlook As Object
Set Outlook = CreateObject("Outlook.Application")
Dim MailItem As Object
Set MailItem = Outlook.CreateItem(0)
With MailItem
Const olFormatHTML As Long = 2
.To = pEmail
.Subject = SUBJECTPREFIX & CustName
.BodyFormat = olFormatHTML
.HTMLBody = TableInfo(TitleCo, clsDate, ContractPrice, lAmount, lnProd, Notes) & "<br><br>" & vbNewLine & .HTMLBody
.Display
'.Send
End With
End Sub
Function TableInfo(ByVal TitleCo As String, ByVal clsDate As String, _
ByVal contPrice As String, ByVal loanAmt As String, ByVal lnProd As String, _
ByVal Notes As String) As String
Dim HTMLBody As String
HTMLBody = getLoanMessageHTML
Dim TBody As String
TBody = getTR(lnProd, loanAmt, clsDate, TitleCo, Notes, contPrice)
HTMLBody = Replace(HTMLBody, TBodyMarker, TBody)
TableInfo = HTMLBody
Debug.Print TableInfo
End Function
Function getLoanMessageHTML()
Dim list As Object
Set list = CreateObject("System.Collections.Arraylist")
list.Add "<html>"
list.Add Space(2) & "<head>"
list.Add Space(4) & "<style>"
Rem Body
list.Add Space(6) & "p {"
list.Add Space(8) & "font-family:Calibri;"
list.Add Space(6) & "}"
Rem Table
list.Add Space(6) & "table {"
list.Add Space(8) & "width:100%;"
list.Add Space(6) & "}"
Rem Table TH TD
list.Add Space(6) & "table, th, td {"
list.Add Space(8) & "border:1px solid gray;"
list.Add Space(8) & "border-collapse:collapse;"
list.Add Space(8) & "text-align:center;"
list.Add Space(6) & "}"
Rem TH
list.Add Space(6) & "th {"
list.Add Space(8) & "background-color:#bdf0ff;"
list.Add Space(6) & "}"
list.Add Space(4) & "</style>"
list.Add Space(2) & "<head>"
list.Add Space(2) & "<body>"
Rem Message To Zack
list.Add Space(4) & "<p>Hello Zack,<br><br></p>"
list.Add Space(4) & BODYINTRO
Rem Table
list.Add Space(4) & "<table>"
Rem Column Group
list.Add Space(6) & "<colgroup>"
list.Add Space(8) & "<col width='10%'>"
list.Add Space(8) & "<col width='10%'>"
list.Add Space(8) & "<col width='10%'>"
list.Add Space(8) & "<col width='10%'>"
list.Add Space(8) & "<col width='10%'>"
list.Add Space(8) & "<col width='10%'>"
list.Add Space(6) & "</colgroup>"
Rem THead
list.Add Space(6) & "<thead>"
list.Add Space(8) & "<tr>"
list.Add Space(10) & "<th>Product</th>"
list.Add Space(10) & "<th>Loan Amount</th>"
list.Add Space(10) & "<th>Closing Date</th>"
list.Add Space(10) & "<th>Title Company</th>"
list.Add Space(10) & "<th>Notes</th>"
list.Add Space(10) & "<th>Contract Price</th>"
list.Add Space(8) & "</tr>"
list.Add Space(6) & "</thead>"
list.Add Space(6) & "<tbody>"
Rem TBody
list.Add Space(6) & TBodyMarker
list.Add Space(6) & "</tbody>"
list.Add Space(4) & "</table>"
list.Add Space(4) & BODYBEFORESIGNATURE
list.Add Space(2) & "</body>"
list.Add "</html>"
getLoanMessageHTML = Join(list.ToArray, vbNewLine)
End Function
Function getTR(ParamArray TDValues() As Variant)
Dim list As Object
Set list = CreateObject("System.Collections.Arraylist")
Dim Item As Variant
list.Add Space(8) & "<tr>"
For Each Item In TDValues
list.Add Space(10) & "<td>" & Item & "</td>"
Next
list.Add Space(8) & "</tr>"
getTR = Join(list.ToArray, vbNewLine)
End Function
以上是关于电子邮件签名未在Outlook中显示的主要内容，如果未能解决你的问题，请参考以下文章
以编程方式生成的数字签名电子邮件在 Outlook 中显示正确，但在 Gmail 中显示不正确