RegEx to extract email

Question

RegEx to extract email

I only need to extract email from a spreadsheet in Excel. I found some sample VB code here on StackOverflow page , courtesy of Portland Runner .

I created an Excel module and it seems to work fine except. It only returns the first uppercase character of the address in the cell and ignores email.

For example:

Text                                    | Result
----------------------------------------|------------------------------
My email address is address@gmail.com   | My email address is  
Yes  Address@gmail.com                  | Yes  A

Below is the code I am using:

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

I don't have enough experience with VB to really diagnose what might be going on here, hopefully someone can figure out what I'm doing wrong.

Working code

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

+1

vba regex excel

Sam Hearn 01 Apr At 13:51

source to share

4 answers

You can change the line

 simpleCellRegex = regEx.Replace(strInput, strReplace)

To

 simpleCellRegex = strInput

Since you are not making a replacement

+1

Pablo ontiveros 01 Apr 15 at 14:07

source to share

The easiest way to do this is to install a software called KUtool. Once installed, highlight the content you want to extract from emails ==> Click ku tools in the top middle ==> click on text ==> extract emails. You can also use the following code. (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

You can also use the code Open excell press ALT + F1 click on the insert module and paste this code

Click Save and enter the formula (Column = ExtractEmailFun (A1)) in a blank cell. hit enter and your emails will be retrieved. Hope this helps

0

Angu Ransom Dec 13. '15 at 6:43

source to share

Try the picture below.

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

-1

izzymo 01 Apr 15 at 13:58

source to share

Marcin wesel · Accepted Answer · 2015-04-01T14:30:54+0000

When you return strInput, you only get the same string as the input. You need to return the value found with RegExp.

Try

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

Instead

simpleCellRegex = regEx.Replace(strInput, strReplace)

RegEx to extract email

Working code

More articles: