Outlook VBA循环处理选中邮件时FirstName提取重复问题排查

你的代码出现重复使用第一封邮件名字的问题，根源很明确：你在循环开始前就固定绑定了第一封选中的邮件，之后所有循环迭代都在复用这封邮件的内容，而没有去读取当前处理的那封邮件的正文。

具体错误点 #

你这行代码：

Set olMail = Application.ActiveExplorer().Selection(1)

直接把olMail指向了选中列表的第一封邮件，后续循环里执行rxp4.Execute(olMail.Body)时，永远都是在处理第一封邮件的正文，自然所有新邮件都会显示Person1。

修复后的完整代码 #

我调整了代码逻辑，让循环迭代时逐个处理选中的每一封邮件，同时加上了类型判断避免非邮件对象的错误：

Sub FindName()
    Dim objSelection As Selection
    Dim obj As Object
    Dim currentMail As Outlook.MailItem
    Dim objMsg As Outlook.MailItem
    Dim rxp4 As New RegExp, m4 As Match, c4 As MatchCollection
    Dim FName As String
    
    ' 获取当前选中的邮件集合
    Set objSelection = Application.ActiveExplorer.Selection
    
    ' 遍历每一个选中的对象
    For Each obj In objSelection
        ' 只处理邮件类型的对象
        If TypeName(obj) = "MailItem" Then
            Set currentMail = obj
            FName = "" ' 每次循环重置名字变量，避免残留上一次的值
            
            ' 配置正则规则
            rxp4.Pattern = "First Name\s*(\s*(\w.*\b))"
            rxp4.Global = True
            
            ' 用当前邮件的正文执行匹配
            Set c4 = rxp4.Execute(currentMail.Body)
            
            ' 提取匹配到的名字（保持原代码的拼接逻辑）
            For Each m4 In c4
                FName = FName & m4.SubMatches(0) & " "
            Next m4
            
            ' 创建新邮件并填充内容
            Set objMsg = Application.CreateItem(olMailItem)
            With objMsg
                .To = "test@mail.com"
                .Subject = currentMail.Subject
                .HTMLBody = _
                    "<HTML><BODY>" & _
                    "<div style='font-size:10pt;font-family:Verdana'>" & _
                    "<table style='font-size:10pt;font-family:Verdana'>" & _
                    "<tbody>" & _
                    "<tr class='blue'><td>" & Trim(FName) & "</td></tr>" & _ ' 去掉多余空格
                    "</tbody>" & _
                    "</table>" & _
                    "</div>" & _
                    "</BODY></HTML>"
                .Display
            End With
        End If
    Next obj
    
    ' 释放对象
    Set objSelection = Nothing
    Set currentMail = Nothing
    Set objMsg = Nothing
    Set rxp4 = Nothing
End Sub

关键改进点 #

• 移除了固定绑定第一封邮件的代码，改为在循环内处理当前迭代的邮件
• 增加了TypeName(obj) = "MailItem"的判断，防止选中日历、任务等非邮件对象时出错
• 每次循环开始时重置FName变量，避免上一次循环的值残留
• 对最终的FName做了Trim()处理，去掉多余的尾部空格
• 变量声明统一放在过程开头，符合VBA编码规范

现在你选中4封邮件运行这个代码，每封新邮件都会正确提取对应原邮件里的FirstName了。

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