regex - Extraiga la dirección de correo electrónico de una tabla en.HTMLbody

vba outlook

Question

Me gustaría responder a un formulario web extrayendo la dirección de correo electrónico del formulario.

El formulario web está en una tabla, por lo tanto, la función ParseTextLinePair () devuelve espacios en blanco como la dirección de correo electrónico en la columna al lado de la etiqueta.

¿Cómo puedo extraer la dirección de correo electrónico de un formulario web?

Sub ReplywithTemplatev2()
Dim Item As Outlook.MailItem
Dim oRespond As Outlook.MailItem

''Get Email
    Dim intLocAddress As Integer
    Dim intLocCRLF As Integer
    Dim strAddress As String

Set Item = GetCurrentItem()

If Item.Class = olMail Then

        '' find the requestor address
        strAddress = ParseTextLinePair(Item.Body, "Email-Adresse des Ansprechpartners *")


'' This sends a response back using a template
Set oRespond = Application.CreateItemFromTemplate("C:/Users/Reply.oft")

With oRespond
    .Recipients.Add Item.SenderEmailAddress
    .Subject = "Your Subject Goes Here"
    .HTMLBody = oRespond.HTMLBody & vbCrLf & _
              "---- original message below ---" & vbCrLf & _
               Item.HTMLBody & vbCrLf

'' includes the original message as an attachment
   '' .Attachments.Add Item

   oRespond.To = strAddress

'' use this for testing, change to .send once you have it working as desired
    .Display


End With

End If
Set oRespond = Nothing

End Sub

Function GetCurrentItem() As Object
    Dim objApp As Outlook.Application

    Set objApp = Application
    On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
        Case "Explorer"
            Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
    End Select

    Set objApp = Nothing
End Function

Function ParseTextLinePair(strSource As String, strLabel As String)
    Dim intLocLabel As Integer
    Dim intLocCRLF As Integer
    Dim intLenLabel As Integer
    Dim strText As String

    '' locate the label in the source text
    intLocLabel = InStr(strSource, strLabel)
    intLenLabel = Len(strLabel)
        If intLocLabel > 0 Then
        intLocCRLF = InStr(intLocLabel, strSource, vbCrLf)
        If intLocCRLF > 0 Then
            intLocLabel = intLocLabel + intLenLabel
            strText = Mid(strSource, _
                            intLocLabel, _
                            intLocCRLF - intLocLabel)
        Else
            intLocLabel = Mid(strSource, intLocLabel + intLenLabel)
        End If
    End If
    ParseTextLinePair = Trim(strText)
End Function

Una imagen de la mesa para aclarar.

Answer 1

¿Has mirado en expresiones regulares en VBA, no he trabajado en él, pero aquí hay un ejemplo.

Option Explicit
Sub Example()
    Dim Item As MailItem
    Dim RegExp As Object
    Dim Search_Email As String
    Dim Pattern As String     
    Dim Matches As Variant

    Set RegExp = CreateObject("VbScript.RegExp")

    Pattern = "/b[A-Z0-9._%+-]+@[A-Z0-9.-]+/.[A-Z]{2,4}/b"

    For Each Item In ActiveExplorer.Selection

        Search_Email = Item.body

        With RegExp
            .Global = False
            .Pattern = Pattern
            .IgnoreCase = True
            Set Matches = .Execute(Search_Email)
        End With

        If Matches.Count > 0 Then
            Debug.Print Matches(0)
        Else
            Debug.Print "Not Found "
        End If

    Next

    Set RegExp = Nothing

End Sub

O Pattern = "(/S*@/w+/./w+)" O "(/w+(?:/W+/w+)*@/w+/./w+)"

Regular-expressions.info/tutorial

/b[A-Z0-9._%+-]+@[A-Z0-9.-]+/.[AZ]{2,}/b Patrón simple que describe una dirección de correo electrónico.

Una serie de letras, dígitos, puntos, guiones bajos, signos de porcentaje y guiones, seguidos de un signo en, seguido de otra serie de letras, dígitos y guiones, seguido de un punto y dos o más letras

[A-Z0-9._%+-]+ Coincide con un solo personaje presente en la lista a continuación

AZ Un solo carácter en el rango entre A y Z (distingue entre mayúsculas y minúsculas)

0-9 Un solo carácter en el rango entre 0 y 9

._%+- Un solo caracter en la lista

@ Coincide con el personaje @ literalmente

Cuantificadores

Udemy.com/vba-regex/

+---------+---------------------------------------------+------------------------------------------------------------+
| Pattern |                   Meaning                   |                          Example                           |
+---------+---------------------------------------------+------------------------------------------------------------+
|         |                                             |                                                            |
| –       | Stands for  a range                         | a-z means all the letters a to z                           |
| []      | Stands for any one of the characters quoted | [abc] means either a, b or c.[A-Z] means either A, B, …, Z |
| ()      | Used for grouping purposes                  |                                                            |
| |       | Meaning is ‘or’                             | X|Y, means X or Y                                          |
| +       | Matches the character one or more times     | zo+ matches ‘zoo’, but not ‘z’                             |
| *       | Matches the character zero or more times    | “lo*” matches either “l” or “loo”                          |
| ?       | Matches the character zero or once          | “b?ve?” matches the “ve” in “never”.                       |
+---------+---------------------------------------------+------------------------------------------------------------+

Wikibooks.org/wiki/Visual_Basic/Regular_Expressions

https://regex101.com/r/oP2yR0/1