仅将对话中的最新回复复制到剪贴板

我有以下 Outlook VBA 代码，可将所选电子邮件的正文复制到 Windows 剪贴板：

Sub CopyMailToClipboard()
On Error GoTo HandleErr
'Copies the selected message to the Clipboard

    Dim M As MailItem
    Set M = ActiveExplorer().Selection.Item(1)

    modClipboard.gfClipBoard_SetData Replace(M.Body, vbCrLf & vbCrLf, vbCrLf)

ExitHere:
    Set M = Nothing
    Exit Sub

HandleErr:
    MsgBox "Error " & Err.Number & ": " & Err.Description, , _
     "CopyMailToClipboard"
    Resume ExitHere
End Sub

这段代码复制了entire邮件正文，包括以前在电子邮件对话中的所有回复。有时我只想复制最近的回复，而不是整个消息：

Outlook 似乎知道邮件的划分位置，如Next and Previous分隔每个先前回复的灰线下方显示的按钮。

如何使用 VBA 仅将对话中的最新回复复制到剪贴板？

我使用的是 Outlook 2013 和 2016。

Outlook 对象模型显然没有公开区分单个电子邮件正文中各个消息的机制。相反，我使用了Split()中断文本消息的功能From::

Sub CopyMailToClipboard(NumMessages As Integer)
On Error GoTo HandleErr
'Copies the selected message to the Clipboard
'NumMessages = Number of messages to return.  Use -1 to return all messages, 1 to return first (most recent)
'               message and so on.


    Dim M As MailItem
    Dim strMyString As String
    Dim strArrMessages() As String
    Dim varMessage As Variant
    Dim i As Integer
    Dim bolIsFirstMessage As Boolean

    Set M = ActiveExplorer().Selection.Item(1)
    strArrMessages() = Split(M.Body, "From: ")     'Split message body into an strArrMessagesay at each occurrance of "From: "
    i = NumMessages     'Set a counter to stop For Each loop when desired # of messages have been returned
    bolIsFirstMessage = True

    For Each varMessage In strArrMessages()
        If i = 0 Then Exit For      'Stop getting messages once i counter reaches 0.  This never triggers
                                    'if numMessages (and therefore i) start at -1, in which case we want
                                    'all messages

        If bolIsFirstMessage Then
            'Add header info to most recent message in thread
            strMyString = "From: " & M.Sender & vbCrLf & _
                "Sent: " & Format(M.SentOn, "dddd, mmmm dd, yyyy h:mm AM/PM") & vbCrLf & _
                "To: " & M.To & vbCrLf & _
                "Subject: " & M.Subject & vbCrLf & _
                vbCrLf & _
                Replace(varMessage, vbCrLf & vbCrLf, vbCrLf)

            bolIsFirstMessage = False

        Else
            strMyString = strMyString & _
                "-------------------------------------------------------------" & vbCrLf & _
                vbCrLf & "From: " & Replace(varMessage, vbCrLf & vbCrLf, vbCrLf)
                'Add the 'From: ' text removed by use of Split()

        End If

        i = i - 1

    Next varMessage

    'Put data on Clipboard
    modClipboard.gfClipBoard_SetData MyString:=strMyString

ExitHere:
    Set M = Nothing
    Exit Sub

HandleErr:
    MsgBox "Error " & Err.Number & ": " & Err.Description, , _
     "CopyMailToClipboard"
    Resume ExitHere
End Sub