如何更改通过Excel通过Excel VBA代码发送的电子邮件的字体格式？

I have VBA code that uses Excel to send a number of emails through Outlook.

我有VBA代码，使用Excel通过Outlook发送大量电子邮件。

It inputs the name of each individual contact into the email body (Dear So-and-so), the company name/invoice number into the subject line (Company ABC Invoice 123), attaches a different file for each contact (Invoice 123.pdf), marks the message as high importance, requests a read receipt, sends on behalf of a secondary email account I use for invoices rather than my personal email account, BCCs to the secondary email, and adds an email signature at the bottom with a picture.

它将每个联系人的姓名输入到电子邮件正文（亲爱的某某），将公司名称/发票号输入主题行（公司ABC发票123），为每个联系人附上不同的文件（Invoice 123.pdf）），将邮件标记为高重要性，请求阅读回执，代表我用于发票的辅助电子邮件帐户而不是我的个人电子邮件帐户，BCC到辅助电子邮件，并在底部添加电子邮件签名和图片。

Most of the code (if not all of it, actually) is from this wonderful Ron de Bruin site.

大多数代码（如果不是全部，实际上）来自这个美妙的Ron de Bruin网站。

I pasted together a lot of code to get where I am and don't know how I managed to get it to work at all.

我粘贴了很多代码来获取我的位置，并且不知道我是如何设法让它工作的。

I tried numerous different "tags" in an attempt to change the font formatting.

我尝试了许多不同的“标签”，试图改变字体格式。

I tried changing Outlook's template settings and taking the code out in hopes that it would input with the "Outlook default" font.

我尝试更改Outlook的模板设置并取出代码，希望它输入“Outlook默认”字体。

There are style tags in my code but they do not have much of an effect. It is set to Times New Roman Size 18.

我的代码中有样式标记，但它们没有太大的影响。它被设置为Times New Roman Size 18。

The "Dear So-and-so" inputs as Times New Roman Size 12. The email body inputs as Calibri 13.5. My signature inputs as whatever I set it to in the signature setup.

“Dear so-so-so”输入为Times New Roman Size 12.电子邮件正文输入为Calibri 13.5。我的签名输入就像我在签名设置中设置的一样。

I want it to all be the same font, size, color, etc.

我想要它们都是相同的字体，大小，颜色等。

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

Edit: Roland Shaw noticed that the font size did not have any clarifications as to what 18 was. 18pts? 18px? 18inches? So I changed the code to the following.

编辑：Roland Shaw注意到字体大小没有任何关于18是什么的澄清。 18pts？ 18像素？ 18英寸？所以我将代码更改为以下内容。

strbody = "<P STYLE='font-family:Times New Roman;font-size:18pt'>

This made the body of the text change formatting but it did not change the "Dear so-and-so" part of the email. Still hoping for some changes there.

这使得文本正文改变格式，但它没有改变电子邮件的“亲爱的某某”部分。仍希望有一些变化。

2nd Edit: h4xpace suggested taking a look at this article for some guidance. I already attempted to follow this guide before posting, but I could not get it to work. I went back and tried to just add what I THOUGHT was the relevant bits of code needed to change the body fonts. Additions and changes to code below:

第2编辑：h4xpace建议看看这篇文章以获得一些指导。在发布之前我已经尝试过遵循本指南，但我无法让它发挥作用。我回去试图添加我认为是改变体字体所需的相关代码。以下代码的添加和更改：

 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>"

This did not work either.

这也不起作用。

I don't know enough about VBA to add the necessary pieces of code without altering what I already have.

我不太了解VBA添加必要的代码片段而不改变我已有的代码。

Final changes

最后的改变

The code works as I initially intended it to now. The two main changes are to the following lines. On strbody I needed to add "pt" to the font-size. Also I needed to put the formatting information before any of the "message contents".

代码按照我最初的预期工作。两个主要变化是以下几行。在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

4 个解决方案

#1

You are almost there, You are creating your email body As

你几乎就在那里，你正在创建你的电子邮件正文As

.HTMLbody = 'SomeText' + strbody(Formatting + MoreText)

Because the formatting section is part way through it only affects the text that follows it. Make .HTMLBody Start with your formatting information and everything that follows will pick it up.

因为格式化部分是通过它的一部分只影响它后面的文本。 Make .HTMLBody从您的格式信息开始，随后的所有内容都会将其提取出来。

#2

What works for me is:

对我有用的是：

.HTMLBody = strbody & TextLine1 & vbcrlf & strbody & TextLine2

i.e. put the formatting string before every line of text.

即将格式化字符串放在每行文本之前。

#3

You need to set the .BodyFormat property of the OutMail object to olFormatHTML.

您需要将OutMail对象的.BodyFormat属性设置为olFormatHTML。

See the example provided here: http://msdn.microsoft.com/en-us/library/office/aa171418(v=office.11).aspx

请参阅此处提供的示例：http：//msdn.microsoft.com/en-us/library/office/aa171418（v = office.11）.aspx

#4

I think that OP and I were trying to work around the same problem wich was to send a message with normal formatting and keep the signature via ron debruin's method.

我认为OP和我试图解决同样的问题，即发送具有正常格式的消息并通过ron debruin的方法保留签名。

I solved my problem by adding:

我通过添加：解决了我的问题：

.BodyFormat = olFormatHTML
.HTMLBody = "<HTML><BODY>" & strbody & "</BODY></HTML>" & .HTMLBody

to the .OutMail object

到.OutMail对象

#1