从 Excel 内容格式化电子邮件正文答案

【问题标题】：Formatting email body from Excel contents从 Excel 内容格式化电子邮件正文
【发布时间】：2019-11-22 03:43:03
【问题描述】：

我有一个包含给定数据的工作表，

我需要使用 Microsoft Outlook 以特定日期所需的格式通过电子邮件发送数据。

假设日期是 2015 年 1 月 5 日。

这就是电子邮件的外观，

代码编写在 Excel 2007 工作簿的模块中，

Public Function FormatEmail(Sourceworksheet As Worksheet, Recipients As Range, CoBDate As Date)

    Dim OutApp As Object
    Dim OutMail As Object
    Dim rows As Range

    On Error GoTo FormatEmail_Error

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    For Each rows In Recipients.Cells.SpecialCells(xlCellTypeConstants)

        If rows.value Like "?*@?*.?*" Then

            Set OutMail = OutApp.CreateItem(0)

            On Error Resume Next
            With OutMail
                .To = rows.value
                .Subject = "Reminder"
                .Body = "Hi All, " & vbNewLine & _
                         vbNewLine
                .display
            End With
            On Error GoTo 0

            Set OutMail = Nothing

        End If

    Next rows

    On Error GoTo 0
    Exit Function

FormatEmail_Error:

    Set OutApp = Nothing
    Application.ScreenUpdating = True
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure FormatEmail of Module modOutlook"

End Function

【问题讨论】：

需要添加/更改什么才能仅粘贴 A 列中值为非零的行？

标签： excel vba excel-2007

【解决方案1】：

如果您想创建格式良好的 Outlook 电子邮件，那么您需要生成带有格式的电子邮件。纯基于文本的电子邮件显然是不够的，因此您必须寻找 HTML 格式的电子邮件。如果是这种情况，您的目标可能是使用 VBA 动态创建 HTML 代码，以模仿 Excel 的良好视觉表示。

在以下链接http://www.quackit.com/html/online-html-editor/ 下，您将找到一个在线 HTML 编辑器，它允许您准备格式精美的电子邮件，然后向您显示获得此格式所需的 HTML 代码。之后，您只需在 VBA 中将电子邮件正文设置为此 HTML 代码使用

.HTMLBody = "your HTML code here"

而不是

.Body = "pure text email without formatting"

如果这还不够，并且您想将部分 Excel 复制/粘贴到该电子邮件中，那么您必须复制部分 Excel，将它们保存为图片，然后将图片添加到您的电子邮件中（一次再次使用 HTML）。如果这是您想要的，那么您将在这里找到解决方案： Using VBA Code how to export excel worksheets as image in Excel 2003?

【讨论】：

这是正确的和片面的。我已经提供了完整的代码。这个网站帮助rondebruin.nl/win/s1/outlook/mail.htm

【解决方案2】：

这是为达到目的而提供的答案。 html 正文是使用字符串构建器概念构建的，并且电子邮件是根据需要形成的（从帖子中更改了电子邮件的子集）。这工作正常。

Public Function FormatEmail(Sourceworksheet As Worksheet, CoBDate As Date, FinalRatioLCR As Variant, FinalRatioAUD As Variant)

Dim OutApp As Object
Dim OutMail As Object
Dim eMsg As String

Dim ToRecipients As String

   On Error GoTo FormatEmail_Error

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

Dim Matrix2_1, Matrix2_2, Matrix2_3, Matrix3_1 As String
Dim FinanceAllCurrency, AllCurrencyT1, AllCurrencyT0, AllCurrencyAUD As Double

'FinanceAllCurrency = FinalRatioLCR
AllCurrencyT1 = 10.12
AllCurrencyT0 = 20.154
'AllCurrencyAUD = FinalRatioAUD
Matrix2_1 = "<td>" & FinalRatioLCR & "</td>"
Matrix2_2 = "<td>" & AllCurrencyT1 & "</td>"
Matrix2_3 = "<td>" & AllCurrencyT0 & "</td>"
Matrix3_1 = "<td>" & FinalRatioAUD & "</td>"

eMsg = "<head><style>table, th, td {border: 1px solid black; border-collapse:" & _
        "collapse;}</style></head><body>" & _
        "<table style=""width:50%""><tr>" & _
        "<th bgcolor=""#D8D8D8"">LCR</th><th bgcolor=""#D8D8D8"">Finance</th>" & _
         "<th bgcolor=""#D8D8D8"">Desk T+1</th><th bgcolor=""#D8D8D8"">Desk T+0</th></tr><tr>" & _
        "<td>All Currency</td>" & Matrix2_1 & Matrix2_2 & _
         Matrix2_3 & _
        "</tr><tr><td>AUD Only</td>" & Matrix3_1 & "<td>-</td>" & _
        "<td> &nbsp; &nbsp;  -  &nbsp;</td></tr></Table></body>"


ToRecipients = GetToRecipients

   Set OutMail = OutApp.CreateItem(0)
   
  
      With OutMail
                .To = ToRecipients
                .Subject = " Report -" & CoBDate
                .HTMLBody = "Hi All, " & "<br></br><br></br><br></br><br></br>" & _
                           eMsg
                .display
                
       End With
       
     On Error GoTo 0
     
     Set OutMail = Nothing

   On Error GoTo 0
   Exit Function

FormatEmail_Error:

    Set OutApp = Nothing
    Application.ScreenUpdating = True
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure FormatEmail of Module modOutlook"

End Function

收件人地址是从一个范围内动态检索的。

Private Function GetToRecipients() As String
Dim rngRows As Range
Dim returnName As String

For Each rngRows In shMapping.Range(MAPPING_EMAIL_RECIPIENTS).rows

If Len(returnName) = 0 Then
    returnName = rngRows.Cells(, 2).value2
ElseIf Len(rngRows.Cells(, 2).value2) > 0 Or rngRows.Cells(, 2).value2 Like "?*@?*.?*" Then
    returnName = returnName & ";" & rngRows.Cells(, 2).value2
End If

Next
GetToRecipients = returnName
End Function

【讨论】：

需要添加/更改什么才能仅粘贴 A 列中值为非零的行？