Как получить все значения из цикла для каждого цикла, у которого есть соответствие регулярному выражению, и отобразить их по электронной почте?

#vba #foreach #outlook #html-email #text-extraction

Вопрос:

Пример содержимого существующего электронного письма:

  • 01131004378-Пункт 1
  • 01121109880-Пункт 2
  • 01983345661-Пункт 3

Макрос должен извлечь числа из существующего электронного письма на основе шаблона регулярного выражения, а затем отобразить их в новом составленном электронном письме.

 Sub GetValue()
    
    Dim olMail As Outlook.MailItem
    Dim Selection As Selection
    Dim obj As Object

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

    For Each obj In Selection

    Set objMsg = Application.CreateItem(olMailItem)
    Dim rxp13 As New RegExp
    rxp13.Pattern = "(d{11}(?=[-]))"
    rxp13.Global = True
    
    Dim m13 As Match, c13 As MatchCollection
    
    Set c13 = rxp13.Execute(olMail.Body)
    
    Dim item As String
    
    For Each m13 In c13
        item = m13.SubMatches(0)
    Next
    

    '......DISPLAY EMAIL ......
    '--------------------------
    With objMsg
        .To = "mail@test.com"
        .Subject = obj.Subject
        .HTMLBody = _
        "<HTML><BODY>" amp; _
        "<div style='font-size:10pt;font-family:Verdana'>" amp; _
        "<table style='font-size:10pt;font-family:Verdana'>" amp; _
        "<tr><td><strong>ITEMS</strong></td></tr>" amp; _
        "<tr>" amp; _
        "<td>" amp; item amp; "</td>" amp; _
        "</tr>" amp; _
        "</table>" amp; _
        "</div>" amp; _
        "</BODY></HTML>"
        
        .Display
        
    End With
    Set objMsg = Nothing
    '----------------------------------------------------------------
    Next
End Sub
 

Ожидаемый результат:

  • 01131004378
  • 01121109880
  • 01983345661

У меня есть только последний:

  • 01983345661

Как отобразить все значения из каждого цикла и поместить их в «<td>» amp; элемент amp; «<td></td>»?

Ответ №1:

Это связано с тем, что ваш код заменял предыдущие item значения.
Попробуйте этот код:

 Sub test1()
    Const txt = "01131004378-Item1" amp; vbLf amp; "01121109880-Item2" amp; vbLf amp; "01983345661-Item3"
    Const pattern = "<td>#</td>"
    
    Dim rxp13 As New RegExp, m13 As Match, c13 As MatchCollection, item As String
    rxp13.pattern = "d{11}(?=[-])"
    rxp13.Global = True
    
    Set c13 = rxp13.Execute(txt)
    If c13.Count Then
        For Each m13 In c13
            item = item amp; vbLf amp; Replace(pattern, "#", m13)
        Next
        item = Mid(item, 2)
        Debug.Print _
            "<HTML><BODY>" amp; vbLf amp; _
            "<div style='font-size:10pt;font-family:Verdana'>" amp; vbLf amp; _
            "<table style='font-size:10pt;font-family:Verdana'>" amp; vbLf amp; _
            "<tr><td><strong>ITEMS</strong></td></tr>" amp; vbLf amp; _
            "<tr>" amp; vbLf amp; _
            item amp; vbLf amp; _
            "</tr>" amp; vbLf amp; _
            "</table>" amp; vbLf amp; _
            "</div>" amp; vbLf amp; _
            "</BODY></HTML>"
    End If
End Sub
 

Выход:

 <HTML><BODY>
<div style='font-size:10pt;font-family:Verdana'>
<table style='font-size:10pt;font-family:Verdana'>
<tr><td><strong>ITEMS</strong></td></tr>
<tr>
<td>01131004378</td>
<td>01121109880</td>
<td>01983345661</td>
</tr>
</table>
</div>
</BODY></HTML>