Copy to Clipboard only the most recent reply in a conversation

问题

I have the following Outlook VBA code that copies the body of the selected e-mail message to the Windows Clipboard:

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

This code copies the entire message body, including all previous replies in the case of an e-mail conversation. Sometimes I only want to copy the most recent reply, not the entire message:

Outlook seems to know where messages are divided as evidenced by the Next and Previous buttons shown below the grey line that divides each prior reply.

How can I use VBA to copy to the Clipboard only the most recent reply in a conversation?

I'm using Outlook 2013 and 2016.

回答1:

The Outlook object model apparently does not expose a mechanism to distinguish individual messages within a single e-mail body. Instead I used the Split() function to break the messages on the text 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

来源：https://stackoverflow.com/questions/39300361/copy-to-clipboard-only-the-most-recent-reply-in-a-conversation