コピーは会話の中で唯一、最新の返信をクリップボードへ

Question

I持っている次の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 

このコードはコピー全体メッセージ本文。電子メールの会話の場合は前のすべての返信が含まれます。時々私は唯一の最も最近の返信をコピーする、全体ではなくメッセージ：

Outlookがそれぞれ前を分割灰色の線の下に示さ Nextと Previousボタンによって証明されるようにメッセージが分割されている場所を知っているようだ

応答。

どのようにしてVBAを使用して、会話内の最新の返信のみをクリップボードにコピーできますか？

私は、Outlookオブジェクトモデルは明らかに1つのメール本文内の個々のメッセージを区別するためのメカニズムを公開しない見通し2013年と2016年

Answer 1

を使用しています。代わりに、私は、テキストFrom:にメッセージを破るためにSplit()機能を使用：

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