仅将对话中的最新回复复制到剪贴板 [英] Copy to Clipboard only the most recent reply in a conversation

问题描述

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

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

此代码复制 entire 邮件正文，包括在进行电子邮件对话时的所有先前答复.有时我只想复制最近的答复，而不是整个消息:

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似乎知道邮件的位置，如灰线下方的Next和Previous按钮所显示的那样，该按钮用于划分每个先前的答复.

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.

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

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

我正在使用Outlook 2013和2016.

I'm using Outlook 2013 and 2016.

推荐答案

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

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

这篇关于仅将对话中的最新回复复制到剪贴板的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！