使用 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
属性(而不是使用HTMLBody
或RtfBVody
深化项目的ss格式),你可以复制所有使用 MailItem.Copy
然后 MailItem.Move
.
的属性
我正在使用 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
属性(而不是使用HTMLBody
或RtfBVody
深化项目的ss格式),你可以复制所有使用 MailItem.Copy
然后 MailItem.Move
.