Question

我的问题如下：

我想定义一个范围，包括我的电子表格中包含格式化文本（粗体字体）的单元格，然后将其转换为我以后可以用作Outlook电子邮件正文的任何对象。

到目前为止，我尝试过的方法之一是通过Ron de Bruin（http://www.rondebruin.nl/win/s1/outlook/bmail2.htm）的RangetoHTML功能。但是，该函数将文本单元格带入另一个excel工作簿，最终在Outlook电子邮件中生成一个表格。我希望保持与excel单元格中的格式完全相同的格式。也就是说，它必须是普通文本的行，而不是邮件中的表格式主体。

这是我目前的代码：

Sub Mail_Selection_Range_Outlook_Body()

Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

Set rng = Sheets("Preparation").Range("A90:A131")
With Selection
.Value = rng.Text
.Font.Bold = rng.Font.Bold
.Font.Color = rng.Font.Color
End With

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
    .To = ""
    .CC = ""
    .BCC = ""
    .Subject = ""
    .HTMLBody = RangetoHTML(rng)
    .Display   
End With
On Error GoTo 0

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

提前感谢您的帮助

Answer 1

Ron de Bruin的RangeToHtml展示了如何使用Excel的PublishObjects将工作表范围转换为可用作电子邮件正文的Html。我相信这已经帮助了成千上万的开发人员。

RdeB克服的困难是PublishObjects旨在创建和维护网页。他的例程输出到文件，然后读取该文件，因为这是获取电子邮件正文所需的Html字符串的唯一方法。

RdeB无法克服的困难是PublishObjects创建质量低劣的专有CSS。 “质量差”，我的意思是有很多不必要的CSS，行高和列宽以点为单位定义，以给出适合PC的尺寸。 “专有”，我的意思是它使用mso-ignore:padding和mso-number-format:General等样式，只有Microsoft浏览器才能保证理解。主流浏览器似乎能够应对，但很多人发现一些较新的浏览器无法应对并显示垃圾。

为了演示并测试我的代码，我根据您的图像创建了一个工作表。第16到18行是右对齐的，因为我已经指定了这一点。第20行到第22行是右对齐的，因为这是数值，日期和时间值的Excel默认值。它的外观是：

您可以使用您的真实数据。

将此代码复制到您的工作簿：

Option Explicit
Sub Test1()

  Dim PathCrnt As String
  Dim PathFileCrnt As String
  Dim RngStr As String
  Dim WshtName As String

  PathCrnt = ThisWorkbook.Path & "\"       ' ## Output to the same folder as workbook holding the macro
  PathFileCrnt = PathCrnt & "Test1.html"   ' ## Change if you do not like my filename
  WshtName = "Sheet1"                      ' ## Change to your worksheet
  RngStr = "A1:A28"                        ' ## Change to your range

  With ThisWorkbook
    With .PublishObjects.Add(SourceType:=xlSourceRange, _
                             Filename:=PathFileCrnt, _
                             Sheet:=WshtName, _
                             Source:=RngStr, _
                             HtmlType:=xlHtmlStatic)
                        .Publish (True)
    End With
  End With

End Sub

您需要更改标有##

的顶部附近的部分语句

运行此宏以将范围输出到文件。

在我的笔记本电脑上，Microsoft Edge，Microsoft Internet Explorer和谷歌浏览器都显示该文件，尽管IE和Chrome显示速度很慢，但它们看起来都一样。该列位于窗口的中心位置：

您没有显示任何背景灰色细胞和宽白色边框。但是，我还没有尝试在Outlook中显示它。

现在使用您喜欢的文本编辑器查看该文件。注意重复多少CSS。注意有多少样式开始“mso-”表示它们是Microsoft扩展。注意以“pt”（点）测量的高度和宽度。一些Html显示引擎可以应付，但有些不能。

我怀疑PublishObjects尚未维护。它可以在Excel 2003中使用，也许更早。一些旧的Microsoft CSS扩展现在具有标准的CSS等价物，但PublishObjects尚未更新以使用它们。

我有自己的RangeToHtml完全用VBA编写。它将处理除边框之外的所有格式。我的代码太大了，无法在Stack Overflow上发布，所以我提取了你需要的位。你显然需要粗体或不粗体左右对齐。我不知道你是否指定了正确的对齐方式，或者你是否有默认情况下正确对齐的数字字段，所以我同时处理它们。

我的函数ColToHtml（范围）返回范围第一列的完整Html文件。我的代码不会创建临时工作簿或临时文件。它产生干净，清晰的Html和Css。它会生成一个表，因为您无法在表外进行右对齐。但是，没有边框，输出就是表格并不明显。外观上唯一的区别是表格左对齐。如果您更喜欢中心表，那将是一个很容易的改变。

这是我的测试程序：

Sub Test2()

  Dim Rng As Range

  With Worksheets("Sheet1")
    Set Rng = .Range(.Cells(1, 1), .Cells(28, 1))
  End With

  Debug.Print ColumnToHtml(Rng)

End Sub

它将Html字符串输出到立即窗口。然后我将其复制到一个文件中。我本可以使用VBA写入文件，但这更容易。当我用Microsoft Edge打开文件时，它看起来一样。使用您喜欢的文本编辑器查看第二个文件。注意它是多么小。 PublishObjects版本为6,901字节，而第二个版本为1,681字节。注意如何仅使用标准Css并且使用最小Css。这允许显示引擎根据输出设备的类型自行决定如何显示文件。

我的最后一次测试是：

Sub Test3()

  ' This will need a reference to Microsoft Outlook nn.0 Outlook library
  ' where nn is the number of the Outlook version you are using.

  Dim Rng As Range
  Dim OutApp As Outlook.Application
  Dim MailItemNew As Outlook.MailItem

  With Worksheets("Sheet1")
    Set Rng = .Range(.Cells(1, 1), .Cells(28, 1))
  End With

  With Application
    .EnableEvents = False
    .ScreenUpdating = False
  End With

  Set OutApp = CreateObject("Outlook.Application")

  Set MailItemNew = OutApp.CreateItem(olMailItem)

  With MailItemNew
    .BodyFormat = olFormatHTML
    .HTMLBody = ColumnToHtml(Rng)
    .Display
  End With

  With Application
    .EnableEvents = True
    .ScreenUpdating = True
  End With

  Set MailItemNew = Nothing
  Set OutApp = Nothing

End Sub

这会将范围输出到Outlook。我已经使用您的代码作为模板但引用了Outlook库，因此我可以使用Outlook对象和常量。我不得不缩小字体大小以便在屏幕上同时显示：

除了每行的第一个字母已大写之外，它具有相同的外观。我不知道如何阻止Outlook电子邮件编辑器执行此操作。

顺便说一下，我选择了整个电子邮件，其外观与您发布的图片相同。

ColumnToHtml的代码如下。请注意，CellToHtml是实际为单元格创建Html的例程。它只处理粗体和右对齐，但很明显，添加其他单元格格式很容易。

Function ColumnToHtml(ByRef RngCol As Range) As String

  ' Returns the first or only column of rng as a borderless table
  ' so it appears as a formatted list of rows.

  Dim RngCell As Range
  Dim RowCrnt As Long
  Dim Table As String

  ' Build an Html table of the cells within the first column of RngCol
  ' ==================================================================

  Table = Space(4) & "<table border=""0"">" & vbLf
  For RowCrnt = RngCol.Row To RngCol.Row + RngCol.Rows.Count - 1
    Set RngCell = RngCol.Worksheet.Cells(RowCrnt, RngCol.Column)
    Table = Table & Space(6) & "<tr>" & CellToHtml(RngCell) & "</tr>" & vbLf
  Next
  Table = Table & Space(4) & "</table>"

  ' Build an Html file envelope around the table
  ' ============================================

  ColumnToHtml = "<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Frameset//EN""" & _
                       """http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd"">" & vbLf & _
                "<html xmlns=""http://www.w3.org/1999/xhtml"" xml:lang=""en"" lang=""en"">" & vbLf & _
                "  <head></head>" & vbLf & _
                "    <meta http-equiv=""Content-Type""content=""text/html; charset=utf-8""/>" & vbLf & _
                "    <style>" & vbLf & _
                "      td.bold {font-weight:bold;}" & vbLf & _
                "      td.hAlign-right {text-align:right;}" & vbLf & _
                "    </style>" & vbLf & _
                "  </head>" & vbLf & _
                "  <body>" & vbLf & Table & vbLf & _
                "  </body>" & vbLf & _
                "</html>"

End Function
Function CellToHtml(ByRef RngCell As Range) As String

  ' Convert a single cell to Html.
  ' This code handles: value, bold or not-bold (default) and left )default) or
  ' right-alignment.

  ' Note RngCell.Value is the value perhaps "1234" or "42999".
  '  and RngCell.Text is the display text perhaps "1,234" or "21-Sep-17".
  ' This is particularly important with dates and time where the
  ' value is unlikely to be what is displayed.
  ' Dates are held as days since 1-Jan-1900 and times are held as
  ' seconds-since-midnight / seconds-in-a-day. It is the NumberFormat that
  ' determine what you see.

  Dim BoldCell As Boolean
  Dim RAlignedCell As Boolean
  Dim Style As String
  Dim StyleNeeded As Boolean

  CellToHtml = "<td"

  ' Add interior formatting here if required

  If RngCell.Value = "" Then
    ' Ignore font and alignment formatting of empty cell.
  Else
    ' Test for formats
    BoldCell = False
    RAlignedCell = False
    Style = ""
    StyleNeeded = False

    If RngCell.Font.Bold Then
      BoldCell = True
      StyleNeeded = True
    End If

    If RngCell.HorizontalAlignment = xlRight Or _
       (RngCell.HorizontalAlignment = xlGeneral And _
        (IsNumeric(RngCell.Value) Or IsDate(RngCell.Value))) Then
      RAlignedCell = True
      StyleNeeded = True
    End If

    If StyleNeeded Then
      CellToHtml = CellToHtml & " class="""
      If BoldCell Then
        If Style <> "" Then
          Style = Style & " "
        End If
        Style = Style & "bold"
      End If

      If RAlignedCell Then
        If Style <> "" Then
          Style = Style & " "
        End If
        Style = Style & "hAlign-right"
      End If

      CellToHtml = CellToHtml & Style & """"

    End If
  End If

  CellToHtml = CellToHtml & ">"  ' Terminate "<td"
  If RngCell.Value = "" Then
    ' Blank rows are displayed narrow.  Use Non-blank space so display at homral width
    CellToHtml = CellToHtml & "&nbsp;"
  Else
    CellToHtml = CellToHtml & RngCell.Text
  End If
  CellToHtml = CellToHtml & "</td>"

End Function

最后一条评论。您没有选择任何内容，因此我没有看到此代码的用途：

With Selection
  .Value = rng.Text
  .Font.Bold = rng.Font.Bold
  .Font.Color = rng.Font.Color
End With

excel-vba：将具有特定格式的单元格中的文本转换为适合Outlook电子邮件正文的对象，同时保持相同的格式属性

1 个答案: