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

Answer 1

You can change the line

 simpleCellRegex = regEx.Replace(strInput, strReplace)

To

 simpleCellRegex = strInput

Because you are not making any replacement

Answer 2

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)

Answer 3

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

Answer 4

Try the below pattern

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