Question

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

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

大多数代码（如果不是全部代码，实际上）来自this wonderful Ron de Bruin site。

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

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

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

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

“亲爱的某某”输入时代新罗马大小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是什么的澄清。 18pts？ 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

Answer 1

你快到了，您正在创建电子邮件正文

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

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

Answer 2

我认为OP和我正在尝试解决同样的问题，即发送具有正常格式的邮件并通过ron debruin's method保留签名。

我通过添加：

解决了我的问题

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

到.OutMail对象

Answer 3

对我有用的是：

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

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

Answer 4

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

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

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

4 个答案: