Outlook VBA代码异常：选中邮件未被回复，却回复同主题最新邮件

你当前的代码错误地获取了选中邮件所在对话里的最新邮件进行回复，而非直接回复选中的目标邮件。问题根源在于这段多余的对话线程处理逻辑：

Dim OutlookConversation As Object
Set OutlookConversation = OutlookMail.GetConversation

Dim OutlookTable As Object
Set OutlookTable = OutlookConversation.GetTable

Dim OutlookAr As Variant
OutlookAr = OutlookTable.GetArray(OutlookTable.GetRowCount)

Dim OutlookReplyToThisMail As Object
Set OutlookReplyToThisMail = OutlookMail.Session.GetItemFromID(OutlookAr(UBound(OutlookAr), 0))

GetConversation会拉取该邮件所属的完整对话线程，OutlookAr(UBound(OutlookAr), 0)取的是对话数组的最后一项——也就是线程里最新的邮件，这就是回复对象跑偏的原因。

修改后的代码 #

直接基于选中的邮件对象执行回复操作，删除多余的对话线程逻辑：

Sub SendEmail()
    Dim OutlookApp As Object
    Dim OutlookMail As Object
   
    Set OutlookApp = CreateObject("Outlook.Application")
    ' 获取选中的第一封邮件
    Set OutlookMail = OutlookApp.ActiveExplorer.Selection.Item(1)
   
    With OutlookMail.ReplyAll
        .Subject = Sheet1.Range("O2") & "_" & .Subject
        .HTMLBody = "<p style='font-family:calibri;font-size:13'>" & _
        Sheet1.Range("D25") & "<br><br>" & _
        Sheet1.Range("D26") & "<br><br>" & _
        Sheet1.Range("D27") & Signature & .HTMLBody
        .Display
    End With
    
    ' 释放对象避免内存泄漏
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
End Sub

说明 #

• 直接调用OutlookMail.ReplyAll即可对选中的邮件发起回复，无需额外处理对话线程
• 保留了你原有的主题修改、HTML内容拼接逻辑
• 添加对象释放代码，优化内存使用

内容的提问来源于stack exchange，提问作者JP0710