如何用VBA 6清理Outlook对话及转发邮件：保留指定邮件内容

Hi there! Let's tackle your two Outlook VBA 6 questions one by one, and I'll help you refine that code you've started too.

First, you need to define what counts as an "employee" (e.g., your company's internal email domain like @yourcompany.com) to tell them apart from customers. Here's a VBA script that targets a selected email conversation, removes all employee-sent messages, and keeps only the customer's original email and their latest reply:

Sub CleanCustomerConversation()
    Dim selectedConv As Conversation
    Dim convItems As SimpleItems
    Dim mailItem As MailItem
    Dim customerDomain As String
    Dim keepRoot As Boolean
    Dim latestCustomerMail As MailItem
    
    ' Replace this with your customer's email domain (or use an array for multiple domains)
    customerDomain = "@externalcustomer.com"
    
    ' Get the conversation from the selected email
    On Error Resume Next
    Set selectedConv = ActiveExplorer.Selection(1).GetConversation
    On Error GoTo 0
    
    If selectedConv Is Nothing Then
        MsgBox "Please select an email that's part of a conversation first!", vbExclamation
        Exit Sub
    End If
    
    Set convItems = selectedConv.GetAllItems
    
    ' First, identify the customer's original root message and their latest reply
    For Each mailItem In convItems
        If InStr(LCase(mailItem.SenderEmailAddress), LCase(customerDomain)) > 0 Then
            ' Mark if this is the original (root) message of the conversation
            If mailItem.Parent = selectedConv.GetRoot Then
                keepRoot = True
            End If
            ' Track the most recent customer email by received time
            If latestCustomerMail Is Nothing Or mailItem.ReceivedTime > latestCustomerMail.ReceivedTime Then
                Set latestCustomerMail = mailItem
            End If
        End If
    Next
    
    ' Delete unwanted messages: employee emails + extra customer messages (keep only root + latest)
    For Each mailItem In convItems
        Dim isCustomerMail As Boolean
        isCustomerMail = InStr(LCase(mailItem.SenderEmailAddress), LCase(customerDomain)) > 0
        
        If Not isCustomerMail Then
            ' Remove employee's message
            mailItem.Delete
        Else
            ' Keep only the original root and latest customer reply
            If (Not keepRoot Or mailItem.Parent <> selectedConv.GetRoot) And mailItem.EntryID <> latestCustomerMail.EntryID Then
                mailItem.Delete
            End If
        End If
    Next
    
    MsgBox "Cleanup done! Kept the customer's original email and their latest reply.", vbInformation
End Sub

Quick notes:

• Update customerDomain to match your customer's actual email domain. If you have multiple customer domains, you can use an array and loop through it to check each email address.
• This works on the selected conversation in Outlook, so make sure you pick one email from the conversation first before running the script.

You mentioned you already have code that writes the email content to a text file — let's build on that. First, let's assume your existing code looks something like this (adjust if yours is different):

Sub SaveMailToText()
    Dim objMail As MailItem
    Dim fso As Object
    Dim textFile As Object
    
    Set objMail = ActiveExplorer.Selection(1)
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set textFile = fso.CreateTextFile("C:\Temp\MailContent.txt", True)
    
    ' Write email body to text file
    textFile.Write objMail.Body
    textFile.Close
    
    MsgBox "Mail content saved to text file!", vbInformation
End Sub

Now, to clean up the text file by removing employee conversations, we need to target the common markers that Outlook uses for old threads — things like -----Original Message----- or employee email addresses in From: lines. Here's how to modify your code to automatically clean the content before saving:

Sub CleanForwardedMailAndSave()
    Dim objMail As MailItem
    Dim fso As Object
    Dim textFile As Object
    Dim cleanBody As String
    Dim employeeDomain As String
    Dim originalMsgMarker As String
    
    ' Replace these with your company's domain and Outlook's conversation marker
    employeeDomain = "@yourcompany.com"
    originalMsgMarker = "-----Original Message-----"
    
    ' Get the selected forwarded email
    On Error Resume Next
    Set objMail = ActiveExplorer.Selection(1)
    On Error GoTo 0
    
    If objMail Is Nothing Then
        MsgBox "Please select a forwarded email first!", vbExclamation
        Exit Sub
    End If
    
    ' Start with the full email body
    cleanBody = objMail.Body
    
    ' Step 1: Keep only your latest reply + the original message (cut off everything after the original marker)
    If InStr(cleanBody, originalMsgMarker) > 0 Then
        cleanBody = Left(cleanBody, InStrRev(cleanBody, originalMsgMarker) + Len(originalMsgMarker) - 1)
    End If
    
    ' Step 2: Remove any employee conversation blocks from the remaining content
    Dim lines() As String
    Dim i As Integer
    Dim skipLine As Boolean
    lines = Split(cleanBody, vbCrLf)
    
    cleanBody = ""
    skipLine = False
    
    For i = LBound(lines) To UBound(lines)
        ' Start skipping lines if we hit an employee's "From:" line
        If InStr(LCase(lines(i)), "from:") > 0 And InStr(LCase(lines(i)), LCase(employeeDomain)) > 0 Then
            skipLine = True
        End If
        
        ' Stop skipping when we hit a blank line (end of the conversation block)
        If skipLine And Trim(lines(i)) = "" Then
            skipLine = False
        End If
        
        ' Add the line to cleaned content only if we're not skipping
        If Not skipLine Then
            cleanBody = cleanBody & lines(i) & vbCrLf
        End If
    Next
    
    ' Save the cleaned content to a text file
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set textFile = fso.CreateTextFile("C:\Temp\CleanedMailContent.txt", True)
    textFile.Write cleanBody
    textFile.Close
    
    MsgBox "Cleaned mail content saved successfully!", vbInformation
End Sub

How this works:

1. First, it cuts off any content after the -----Original Message----- marker, which keeps your latest reply and the original customer email.
2. Then it scans each line of the remaining text, skipping any blocks that start with an employee's From: line until it hits a blank line (the end of that conversation thread).
3. If your Outlook uses different conversation markers (like -----Reply----- or custom headers), just update the originalMsgMarker variable to match.

If your original code uses HTML body instead of plain text, let me know and I can adjust the script to handle HTML content too!

内容的提问来源于stack exchange，提问作者انس الواصل