Question

我的Exchange服务器空间有限，因此我想将Outlook 2007收件箱中的所有选定邮件转换为HTML格式，因为它们比涉及图像时的Rich Text格式等效要小。我有以下代码，哪种工作，但格式遍布整个地方，图像变得不可读的附件，大小不会改变。

Public Sub ConvertHTML()

    Dim selItems As Selection
    Dim myItem As Object

' Set reference to the Selection.
    Set selItems = ActiveExplorer.Selection

' Loop through each item in the selection.
    For Each myItem In selItems
        myItem.Display
        myItem.BodyFormat = olFormatHTML
        myItem.Close olSave
    Next

    MsgBox "All Done. Email converted to HTML.", vbOKOnly, "Message"

    Set selItems = Nothing

End Sub

如果我手动执行此操作： - 打开Rich Text电子邮件，编辑邮件，更改为HTML，保存并关闭，然后格式化保留，图像保持嵌入状态并减少邮件大小。我怎样才能在VBA中复制这个？我检查了BodyFormat文档，它确实警告格式化丢失，因此可能无法实现。感谢

Answer 1

如果有关于BodyFormat属性和三种身体格式的明确文档，我从未发现它。

自Outlook 2003以来，MailItem已经具有Body和HtmlBody属性。我在Outlook 2010之前找不到属性RTFBody。我检查的大多数电子邮件都有Body和HtmlBody。我从未见过RTFBody。 Outlook 2003可以选择创建RTF主体，但显然，除了作为Html主体之外，无法存储它。我从未尝试过创建RTF主体，因为很少有朋友使用Outlook，我怀疑他们的电子邮件包支持RTF。

我知道如果修改HtmlBody，Outlook会修改Body来匹配。这不是一个非常复杂的修正案;据我所知，新的Body只是删除了所有Html标签的新HtmlBody。

将正文格式从RTF更改为Html会发生什么？ Outlook是否会删除RTF主体，以便您在幕后看到错误的Html主体？ Outlook是否会尝试从RTF主体创建一个Html主体？我不知道，但也许我们可以找到答案。

下面的宏将Html文件保存为桌面上的Html文件。我的浏览器完美显示这些文件。请使用RTF正文在您的一些电子邮件上试用此宏。目标是发现是否有一个好的Html主体隐藏在RTF主体后面。如果有，我建议你试试：

将Html正文保存为字符串。
将正文格式更改为Html。
清除RTF正文。
从字符串中恢复Html正文。

Option Explicit
Sub CheckHtmlBody()

  ' Technique for locating desktop from answer by Kyle:
  ' http://stackoverflow.com/a/17551579/973283

  Dim Exp As Outlook.Explorer
  Dim InxS As Long
  Dim Path As String

  Path = CreateObject("WScript.Shell").SpecialFolders("Desktop")

  Set Exp = Outlook.Application.ActiveExplorer

  If Exp.Selection.Count = 0 Then
    Debug.Print "No emails selected"
  Else
    For InxS = 1 To Exp.Selection.Count
      With Exp.Selection(InxS)
        If .HtmlBody <> "" Then
          Call PutTextFileUtf8(Path & "\TestHtml" & InxS & ".htm", .HtmlBody)
        End If
      End With
    Next
  End If

End Sub
Public Sub PutTextFileUtf8(ByVal PathFileName As String, ByVal FileBody As String)

  ' Outputs FileBody as a text file (UTF-8 encoding without leading BOM)
  ' named PathFileName

  ' Needs reference to "Microsoft ActiveX Data Objects n.n Object Library"
  ' I have only tested with version 6.1.

  '  1Nov16  Copied from http://stackoverflow.com/a/4461250/973283
  '          but replaced literals with parameters

  Dim BinaryStream As Object
  Dim UTFStream As Object

  Set UTFStream = CreateObject("adodb.stream")

  UTFStream.Type = adTypeText
  UTFStream.Mode = adModeReadWrite
  UTFStream.Charset = "UTF-8"
  UTFStream.LineSeparator = adLF
  UTFStream.Open
  UTFStream.WriteText FileBody, adWriteLine

  UTFStream.Position = 3 'skip BOM

  Set BinaryStream = CreateObject("adodb.stream")
  BinaryStream.Type = adTypeBinary
  BinaryStream.Mode = adModeReadWrite
  BinaryStream.Open

   'Strips BOM (first 3 bytes)
  UTFStream.CopyTo BinaryStream

  UTFStream.Flush
  UTFStream.Close
  Set UTFStream = Nothing

  BinaryStream.SaveToFile PathFileName, adSaveCreateOverWrite
  BinaryStream.Flush
  BinaryStream.Close
  Set BinaryStream = Nothing

End Sub

Outlook VBA将RTF格式转换为HTML格式

1 个答案: