RegEx提取电子邮件

我只需要从Excel中的电子表格中提取电子邮件。 我在StackOverflow 链接中find了一些示例VB代码，由Portland Runner提供 。

我创build了一个Excel模块，似乎工作正常，除了。 它只将地址的第一个大写字母返回给单元格，而忽略电子邮件。

例如：

Text | Result ----------------------------------------|------------------------------ My email address is [e-mail] | My email address is Yes [e-mail] | Yes A 

以下是我正在使用的代码：

 Function simpleCellRegex(Myrange As Range) As String Dim regEx As New RegExp Dim strPattern As String Dim strInput As String Dim strReplace As String Dim strOutput As String strPattern = "[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*@(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?" If strPattern <> "" Then strInput = Myrange.Value strReplace = "" With regEx .Global = True .MultiLine = True .IgnoreCase = False .Pattern = strPattern End With If regEx.test(strInput) Then simpleCellRegex = regEx.Replace(strInput, strReplace) Else simpleCellRegex = "Not matched" End If End If End Function 

我没有足够的经验与VB来真正诊断可能发生在这里，希望有人能够发现我做错了什么。

工作代码

 Function simpleCellRegex(Myrange As Range) As String Dim regEx As New RegExp Dim strPattern As String Dim strInput As String Dim strReplace As String Dim strOutput As String strPattern = "[A-Za-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*@(?:[a-z0-9](?:[a-zA-Z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?" If strPattern <> "" Then strInput = Myrange.Value strReplace = "" With regEx .Global = True .MultiLine = True .IgnoreCase = True .Pattern = strPattern End With If regEx.Test(strInput) Then Set matches = regEx.Execute(strInput) simpleCellRegex = matches(0).Value Else simpleCellRegex = "Not matched" End If End If End Function 

Answer 1

当你返回strInput你只是得到相同的string作为input。 您需要返回使用RegExpfind的值。

尝试

 Set matches = regEx.Execute(strInput) simpleCellRegex = matches(1).Value 

代替

 simpleCellRegex = regEx.Replace(strInput, strReplace) 

Answer 2

你可以改变线

  simpleCellRegex = regEx.Replace(strInput, strReplace) 

至

  simpleCellRegex = strInput 

因为你没有做任何更换

Answer 3

最简单的方法是安装名为KUtool的软件。 安装后，突出显示您想要提取电子邮件的内容==>点击顶部中间的ku工具==>点击文本==>提取电子邮件。 您也可以使用下面的代码（ALT + F1 ==> INSERT MODULE）

 Function ExtractEmailFun(extractStr As String) As String 'Update 20130829 Dim CharList As String On Error Resume Next CheckStr = "[A-Za-z0-9._-]" OutStr = "" Index = 1 Do While True Index1 = VBA.InStr(Index, extractStr, "@") getStr = "" If Index1 > 0 Then For p = Index1 - 1 To 1 Step -1 If Mid(extractStr, p, 1) Like CheckStr Then getStr = Mid(extractStr, p, 1) & getStr Else Exit For End If Next getStr = getStr & "@" For p = Index1 + 1 To Len(extractStr) If Mid(extractStr, p, 1) Like CheckStr Then getStr = getStr & Mid(extractStr, p, 1) Else Exit For End If Next Index = Index1 + 1 If OutStr = "" Then OutStr = getStr Else OutStr = OutStr & Chr(10) & getStr End If Else Exit Do End Ifenter code here Loop ExtractEmailFun = OutStr End Function 

你也可以用代码的方式打开excell，点击ALT + F1，点击插入模块并粘贴这段代码

单击保存并在空白单元格中input公式（Column = ExtractEmailFun（A1））。 按回车，您的电子邮件将被提取。 希望这会有所帮助

Answer 4

尝试下面的模式

 strPattern = "^([a-zA-Z0-9_\-\.]+)@[a-z0-9-]+(\.[a-z0-9-]+)*(\.[az]{2,3})$"