如何用VBA捕获Outlook编辑中邮件的文本（含回复新增内容）

在用户通过新窗口或预览窗口回复邮件并撰写新增文本时，需要捕获这些新增内容，但遇到以下情况：

• 若选中部分新增文本，可正常捕获选中文本；
• 尝试捕获窗口显示的完整邮件文本（含新增内容）时，现有代码只能获取原邮件文本，无法拿到新增内容。

现有获取当前邮件对象的代码：

Function GetCurrentMail() As Object
' 获取正在编辑的当前邮件对象，此函数正常工作
Dim CurrentMail As Object

Select Case TypeName(ActiveWindow)

    Case Is = "Explorer"
        Set CurrentMail = ActiveExplorer.Selection.Item(1)
    Case Is = "Inspector"
        Set CurrentMail = ActiveInspector.CurrentItem
    Case Else
        GoTo CE

End Select

If CurrentMail Is Nothing Or TypeName(CurrentMail) <> "MailItem" Then GoTo CE

Set GetCurrentMail = CurrentMail

CE:

End Function

捕获选中文本的代码（可正常获取用户输入的新增文本）：

Function GetHighlighted() As String

Dim olInsp As Object
Dim wdDoc As Object
Dim strText As String

With GetCurrentMail
    Set olInsp = .GetInspector
    Set wdDoc = olInsp.WordEditor
    strText = wdDoc.Application.Selection.Range.Text
End With

GetHighlighted = strText

Set olInsp = Nothing
Set wdDoc = Nothing

End Function

尝试过使用GetCurrentMail.Body，但仅返回回复前的原邮件文本，无法获取新增内容。

MailItem.Body不会实时同步Inspector窗口中正在编辑的内容，只有用户手动保存或焦点离开编辑窗口时才会更新。要获取包含新增内容的完整邮件文本，需通过Inspector的WordEditor对象直接读取整个文档内容：

Function GetFullMailContent() As String

Dim olInsp As Object
Dim wdDoc As Object
Dim fullContent As String

With GetCurrentMail
    Set olInsp = .GetInspector
    Set wdDoc = olInsp.WordEditor
    ' 获取整个编辑文档的完整文本
    fullContent = wdDoc.Range.Text
End With

GetFullMailContent = fullContent

Set olInsp = Nothing
Set wdDoc = Nothing

End Function

如果需要区分新增文本与原邮件内容，可进一步解析邮件结构（原邮件通常带有引用标记如>或分隔线）；若仅需完整编辑内容，上述代码即可满足需求。

内容的提问来源于stack exchange，提问作者Jaspos