从 .HTMLbody 中的 table 中提取电子邮件地址

Question

我想回复一个从表单中提取电子邮件地址的网络表单。

Web 表单位于 table 中，因此 ParseTextLinePair() 函数 returns 空白作为标签旁边列中的电子邮件地址。

如何从网络表单中提取电子邮件地址？

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

一张图片 table 澄清一下。

Answer 1

你看过 VBA 中的正则表达式了吗，我有一段时间没有研究过它，但这里有一个例子。

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

或Pattern = "(\S*@\w+\.\w+)"或"(\w+(?:\W+\w+)*@\w+\.\w+)"

Regular-expressions.info/tutorial

\b[A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,}\b 描述电子邮件地址的简单模式。

一系列字母、数字、点、下划线、百分号和连字符，后跟一个 at 符号，接着是另一系列字母、数字和连字符，最后是一个点和两个或更多字母[=72=]

[A-Z0-9._%+-]+ 匹配下面列表中的单个字符

A-Z A 和 Z 之间的单个字符（区分大小写）

0-9 0到9之间的单个字符

._%+- 列表中的单个字符

@ 字面上匹配字符@

量词

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

从 .HTMLbody 中的 table 中提取电子邮件地址

Extract Email address from a table in .HTMLbody

regex

vba

outlook

outlook-2010