循环浏览选定的电子邮件并在每封电子邮件上显示名字答案

【问题标题】：Loop through selected emails and display the first name on each email循环浏览选定的电子邮件并在每封电子邮件上显示名字
【发布时间】：2021-10-12 23:59:29
【问题描述】：

如果我在 Outlook 中选择 4 封电子邮件并运行下面的代码，它应该会创建 4 封电子邮件正文上具有不同名字的新电子邮件。但该代码仅获取电子邮件 1 上的名字，并将其显示到第 2 到第 4 个。

例子：

电子邮件 1：名字 Person1
电子邮件 2：名字 Person2
电子邮件 3：名字 Person3
电子邮件 4：名字 Person4

生成的邮件结果应该是：

电子邮件 1：Person1
电子邮件 2：Person2
电子邮件 3：Person3
电子邮件 4：Person4

Sub FindName()

Dim olMail As Outlook.MailItem
Dim Selection As Selection
Dim obj As Object
Set olMail = Application.ActiveExplorer().Selection(1)
Set Selection = Application.ActiveExplorer.Selection


For Each obj In Selection
    Set objMsg = Application.CreateItem(olMailItem)

    Dim rxp4 As New RegExp, m4 As Match, c4 As MatchCollection, FName As String
    rxp4.pattern = "First Name\s*(\s*(\w.*\b))"
    rxp4.Global = True
    
    Set c4 = rxp4.Execute(olMail.Body)
    
    For Each m4 In c4
        FName = m4.SubMatches(0) + " "
    Next
    

    '--------------------------
    With objMsg
        .To = "test@mail.com"
        .Subject = obj.Subject
        '.Body = obj.Body
        .HTMLBody = _
        "<HTML><BODY>" & _
        "<div style='font-size:10pt;font-family:Verdana'>" & _
        "<table style='font-size:10pt;font-family:Verdana'>" & _
        "<tbody>" & _
        "<tr class='blue'><td>" + FName & "</td></tr>" & _
        "<tbody>" & _
        "</table>" & _
        "</div>" & _
        "</BODY></HTML>"
        
        .Display
        
    End With
    
    '---------------------------
Next

End Sub

【问题讨论】：

标签： vba loops email foreach outlook

【解决方案1】：

部分答案 - 我不熟悉 RegEx，但我会在您的代码的前半部分进行一些更改

Sub FindName()
   Dim olMail As Outlook.MailItem
   Dim Selection As Selection
   Dim obj As Object
   
   ' Added or moved the following
     Dim rxp4 As New RegExp, m4 As Match, c4 As MatchCollection, FName As String
     Dim Ptr As Integer
   ' End of Additions
   
   'Set olMail = Application.ActiveExplorer().Selection(1)
   Set Selection = Application.ActiveExplorer.Selection
   
   For Each obj In Selection
      ' Added the following
        Ptr = Ptr + 1
        Set olMail = Application.ActiveExplorer().Selection(Ptr)
      ' End of Aadditions
      Set objMsg = Application.CreateItem(olMailItem)
      'Dim rxp4 As New RegExp, m4 As Match, c4 As MatchCollection, FName As String
      rxp4.Pattern = "First Name\s*(\s*(\w.*\b))"
      rxp4.Global = True

【讨论】：