從.HTMLbody中的表中提取電子郵件地址

我想回復從表單中提取電子郵件地址的網絡表單。從.HTMLbody中的表中提取電子郵件地址

Webform在表中，因此ParseTextLinePair（）函數返回空白作爲標籤旁邊列中的電子郵件地址。

如何從網絡表格中提取電子郵件地址？

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

表中的的圖象，以澄清。

來源

2016-09-18 user3772665

你可能有'Item.HTMLBody'更好的運氣，它返回一個HTML結構串ÿ你可以用它從「

」中解析出合適的'

'元素。不要使用字符串函數來解析HTML，不過，有專爲此設計的庫更適合。否則，如果您可以截取此電子郵件表的外觀，可能會有更簡單的方法？ –

新增了屏幕截圖。帶2列和9行的表格。 – user3772665

回答

你有沒有在看正則表達式在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._%+-][email protected][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._%+-][email protected][A-Z0-9.-]+\.[A-Z]{2,}\b描述電子郵件地址的簡單模式。

一串字母，數字，點，下劃線，百分號和連字符，接着是在符號，後跟另一系列的字母，數字和連字符，最後是一個點和兩個或多個字母

[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

來源

2016-09-20 07:36:08 0m3r

非常感謝，適用於電子郵件地址。原因我想要使用基於表格的解決方案或上述解決方案的原因是我還想從第二列的第一行檢索條目。 – user3772665

出現關於提取電子郵件地址的問題已得到令人滿意的回答。考慮接受它並創建一個新問題。 http://stackoverflow.com/help/accepted-answer – niton

如何有超過1個電子郵件地址？ – pablo808