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