RegEx to extract email

Question

I need to extract only the email from a spreadsheet in Excel. I've found some example VBA code here at this StackOverflow link, courtesy of Portland Runner.

I created an Excel module and it seems to be working fine, except it only returns the first uppercase character of the address into the cell and it's ignoring the 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'm 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 do not have enough experience with VBA to really diagnose what might be happening here, hopefully someone will be able to spot 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

If you are not specifying both upper and lower case in your RegEx pattern mask but wish to catch a case-insensitive result, shouldn't `.IgnoreCase = False` be `.IgnoreCase = True`? — , Apr 01 '15 at 13:56
What you're saying makes sense, but changing `.IgnoreCase = False` has no effect on the results. — Sam Hearn, Apr 01 '15 at 14:05
@pnuts I've changed the `.IgnoreCase` to true in my code. I've noted that this is actually **working** but backwards! The code extracts everything except the email. How do we make the code work in reverse? — Sam Hearn, Apr 02 '15 at 06:52

score 1 · Answer 1 · answered Apr 01 '15 at 14:07

1

You can change the line

 simpleCellRegex = regEx.Replace(strInput, strReplace)

To

 simpleCellRegex = strInput

Because you are not making any replacement

answered Apr 01 '15 at 14:07

Pablo Ontiveros

11
3

I was thinking along this line, but in essence this only copies the value of the cell. It's not extracting the address – Sam Hearn Apr 01 '15 at 14:11

score 1 · Accepted Answer · answered Apr 01 '15 at 14:30

1

When You return strInput You just get the same string as the input. You need to return Value that has been found using RegExp.

Try

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

Instead of

simpleCellRegex = regEx.Replace(strInput, strReplace)

answered Apr 01 '15 at 14:30

Marcin Wesel

94
5

Thank you @Marcin Wesel this should be working, but I get a #VALUE! error in my cells for the correctly matched emails. Is a formatting issue perhaps? – Sam Hearn Apr 02 '15 at 08:12
Figured out that it was looking for the second instance of a match with your code. Changed `matches(1).Value` to `matches(0).Value` – Sam Hearn Apr 02 '15 at 08:29

score 0 · Answer 3 · answered Dec 13 '15 at 06:43

The easiest way to do this is by installing the software called KUtool. After installing, highlight the content you want to extract emails==>Click ku tools at 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 go the code way Open excell, click on ALT +F1, Click on insert Module and paste this code

Click save and enter the formula(Column=ExtractEmailFun(A1)) in a blank cell. press enter and your emails will be extracted. Hope this will help

izzymo · Answer 4 · 2015-04-01T14:04:18.430

-1

Try the below pattern

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

edited Apr 01 '15 at 14:04

answered Apr 01 '15 at 13:58

izzymo

916
1
10
14

RegEx to extract email

Working Code

4 Answers4

Linked