Search code examples
vbaforeachoutlookhtml-emailtext-extraction

How to get all values from the for each loop that has regex matches and display it on email?

Sample content of the existing email:

  • 01131004378-Item1
  • 01121109880-Item2
  • 01983345661-Item3

The macro should extract the numbers from the existing email based on the regex pattern and then display it in a new composed email.

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 = "[email protected]"
        .Subject = obj.Subject
        .HTMLBody = _
        "<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>" & item & "</td>" & _
        "</tr>" & _
        "</table>" & _
        "</div>" & _
        "</BODY></HTML>"
        
        .Display
        
    End With
    Set objMsg = Nothing
    '----------------------------------------------------------------
    Next
End Sub

The expected result:

  • 01131004378
  • 01121109880
  • 01983345661

I only got the last one:

  • 01983345661

How to display all the values from the for each loop and put it into the "<td>" & item & "</td>"?

Solution

  • This is because your code was replacing previous item values.
    Try this code:

    Sub test1()
    Const txt = "01131004378-Item1" & vbLf & "01121109880-Item2" & vbLf & "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 & vbLf & Replace(pattern, "#", m13)
        Next
        item = Mid(item, 2)
        Debug.Print _
            "<HTML><BODY>" & vbLf & _
            "<div style='font-size:10pt;font-family:Verdana'>" & vbLf & _
            "<table style='font-size:10pt;font-family:Verdana'>" & vbLf & _
            "<tr><td><strong>ITEMS</strong></td></tr>" & vbLf & _
            "<tr>" & vbLf & _
            item & vbLf & _
            "</tr>" & vbLf & _
            "</table>" & vbLf & _
            "</div>" & vbLf & _
            "</BODY></HTML>"
    End If
End Sub

    Output:

    <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>