使用 VBA 如何将富文本从一个 Outlook 项目复制到另一个

Using VBA How to copy the rich text from one outlook item to another

我正在使用 Outlook 2019 将邮件从一个 Outlook 项目复制到另一个。问题是它不复制富文本。这是我正在使用的代码示例。此贴显着减少:

Option Explicit
Sub EmailTest()

Dim objOutlookApp               As Object
Dim objOriginalItem             As Object
Dim objNewItem                  As Object
Dim objInspector                As Object
Dim objAccount                  As Object
Dim strEmailAddress             As String

'Set objInspector
Set objInspector = Application.ActiveInspector

'Set objOriginalItem so that it can be referenced
Set objOriginalItem = objInspector.CurrentItem

'Set objNewItem to create the new message.
Set objNewItem = Application.CreateItem(0)

'Set objOutlook App
Set objOutlookApp = CreateObject("Outlook.Application")

'Copy the original Body into the new item Body
objNewItem.Body = objOriginalItem.Body

'Copy the original Subject into the new item Subject
objNewItem.Subject = objOriginalItem.Subject

    'Assign strEmailAddress
    strEmailAddress = "myname@gmail.com"

    'Set the fields of the MailItem.  Note:  objNewItem.Body was previously set
    With objNewItem
        .Display
        .Subject = objOriginalItem.Subject
        .To = strEmailAddress
        .Send
    End With
    Set objNewItem = Nothing

Set objOriginalItem = Nothing
Set objInspector = Nothing
Set objOutlookApp = Nothing

End Sub

原始邮件正文如下:
这是一些粗斜体文本,
这是一些普通的文字
这是一个linkhttps://msn.com
这是一些普通的文字
此致,

很遗憾,这是发送的内容:
这是一些粗斜体文本,
这是一些普通的文字
这是一个linkhttps://msn.comhttps://msn.com/
这是一些普通的文字
此致,

问题:如何使用 VBA 发送既保留富文本属性又保留 link 的消息?

首先,代码中不需要新建Application实例:

'Set objOutlook App
Set objOutlookApp = CreateObject("Outlook.Application")

注意,您使用的是纯文本Body属性复制邮件内容:

'Copy the original Body into the new item Body
objNewItem.Body = objOriginalItem.Body

相反,您需要使用 HTMLBody 属性:

'Copy the original Body into the new item Body
objNewItem.HTMLBody = objOriginalItem.HTMLBody

除了避免复制纯文本Body 属性(而不是使用HTMLBodyRtfBVody深化项目的ss格式),你可以复制所有使用 MailItem.Copy 然后 MailItem.Move.

的属性