【发布时间】：2014-02-19 21:45:36
【问题描述】：
我有使用 Excel 通过 Outlook 发送大量电子邮件的 VBA 代码。
它将每个联系人的姓名输入电子邮件正文（亲爱的某某），将公司名称/发票编号输入主题行（Company ABC Invoice 123），为每个联系人附加不同的文件（发票123.pdf），将邮件标记为高重要性，请求已读回执，代表我用于发票的辅助电子邮件帐户而不是我的个人电子邮件帐户发送，密件抄送到辅助电子邮件，并在底部添加电子邮件签名有图片。
大部分代码（如果不是全部，实际上）来自this wonderful Ron de Bruin site。
我将大量代码粘贴在一起以达到我现在的位置，但我完全不知道我是如何让它工作的。
我尝试了许多不同的“标签”来尝试更改字体格式。
我尝试更改 Outlook 的模板设置并取出代码，希望它可以使用“Outlook 默认”字体输入。
我的代码中有样式标签，但它们没有太大的作用。它设置为 Times New Roman 尺寸 18。
“亲爱的某某”输入为 Times New Roman Size 12。 电子邮件正文输入为 Calibri 13.5。 我的签名输入为我在签名设置中设置的任何内容。
我希望它们都是相同的字体、大小、颜色等。
Sub Mail_Outlook_With_Signature_Html_1()
' Working in Office 2000-2013
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim strbody As String
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("Sheet1")
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
strbody = "<P STYLE='font-family:Times New Roman;font-size:18'>This is the message text for each message. This is all the same for each contact!</P>"
On Error Resume Next
With OutMail
.Display
.To = cell.Value
.CC = ""
.BCC = "MyCompanyEmail@company.com"
.Subject = Cells(cell.Row, "D").Value
.HTMLBody = "Dear " & Cells(cell.Row, "A").Value & "," & "<br>" & "<br>" & strbody & .HTMLBody
.Importance = 2
.ReadReceiptRequested = True
.SentOnBehalfOfName = """My Company Email Name"" <MyCompanyEmail@company.com>"
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
编辑： Roland Shaw 注意到字体大小没有任何关于 18 是什么的说明。 18分？ 18 像素？ 18寸？所以我将代码更改为以下内容。
strbody = "<P STYLE='font-family:Times New Roman;font-size:18pt'>
这使文本的正文更改了格式，但并未更改电子邮件的“亲爱的某某”部分。仍然希望那里有一些变化。
第二次编辑：h4xpace 建议查看this article 以获得一些指导。我已经尝试在发布之前遵循本指南，但我无法让它发挥作用。我回去尝试添加我认为是更改正文字体所需的相关代码位。以下代码的添加和更改：
With OutMail
.Display
.To = cell.Value
.CC = ""
.BCC = "MyCompanyEmail@company.com"
.Subject = Cells(cell.Row, "D").Value
**.BodyFormat = olFormatHTML**
.HTMLBody = **"<HTML><BODY><b>"**Dear " & Cells(cell.Row, "A").Value & "," & "<br>" & "<br>" & strbody & .HTMLBody **</b></BODY></HTML>"**
.Importance = 2
.ReadReceiptRequested = True
.SentOnBehalfOfName = """My Company Email Name"" <MyCompanyEmail@company.com>"
这也不起作用。
我对 VBA 的了解不够，无法添加必要的代码片段而不改变我已有的内容。
最终改动
代码按照我最初的预期工作。两个主要变化是以下几行。在 strbody 上，我需要将“pt”添加到字体大小。我还需要将格式信息放在任何“消息内容”之前。
strbody = "<P STYLE='font-family:TimesNewRoman;font-size:12.5pt;color: rgb(31,73,125)'>This is the message text for each message. This is all the same for each contact!</P>"
.HTMLBody = "<P STYLE='font-family:TimesNewRoman;font-size:12.5pt;color: rgb(31,73,125)'>Dear " & Cells(cell.Row, "A").Value & "," & "<br>" & "<br>" & strbody & .HTMLBody
【问题讨论】：
-
@Kiquenet 我做到了。下面的 0 票用户实际上是在引导我朝着正确的方向前进。我必须在输入文本之前添加格式......我将 .HTMLBody 代码更改为以下内容：
.HTMLBody = "<P STYLE='font-family:Times New Roman;font-size:18'>Hello " & Cells(cell.Row, "B").Value & "," & "<br>" & "<br>" & strbody & .HTMLBody -
@Chonchos 你可以投票给他
标签： excel vba outlook formatting