VBA To Extract Email Address From Text

[dunndealpr]

Just drag the formula down all the way

OK, so I've attached the test document I'm working with. Two questions.

1) When I enter =ExtractEmail(A1) and hit enter, I see nothing. Blank cell. When I save and close and re-open, I see the extracted email. What gives?

2) When you say "just drag the formula down all the way" do you mean select all the cells in column B next to the ones you want answers for, and then enter =ExtractEmail(A1:A5) and hit enter? Because when I do that I get #VALUE!


Thanks again.

[bakerman]

Use the function like this

Function ExtractEmail(strInputText As String) As String

    Dim regEx As Object
    Dim varResults As Object
    Dim varEach
    Dim lng As Long
    With CreateObject("vbscript.RegExp")
    .Pattern = "(?:[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*|""(?:[\x01-\x08\x0b\x0c\x0e-\x1f\x21\x23-\x5b\x5d-\x7f]|\\[\x01-\x09\x0b\x0c\x0e-\x7f])*"")@(?:(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?|\[(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?|[a-z0-9-]*[a-z0-9]:(?:[\x01-\x08\x0b\x0c\x0e-\x1f\x21-\x5a\x53-\x7f]|\\[\x01-\x09\x0b\x0c\x0e-\x7f])+)\])"
    .IgnoreCase = True 'True to ignore case
    .Global = True 'True matches all occurances, False matches the first occurance
    If .Test(strInputText) Then
        Set varResults = .Execute(strInputText)
        For lng = 1 To varResults.Count
            ExtractEmail = ExtractEmail & varResults.Item(0).Value & "|||"
        Next
        ExtractEmail = Left(ExtractEmail, Len(ExtractEmail) - Len("|||"))
        ExtractEmail = Join(Split(ExtractEmail, "|||"), ", ")
    End If
    End With
End Function

To drag the formula down, grab the little square in the bottom-right corner of B1 and pull down

[Rick Rothstein]

OK, so I've attached the test document I'm working with. Two questions.

1) When I enter =ExtractEmail(A1) and hit enter, I see nothing. Blank cell. When I save and close and re-open, I see the extracted email. What gives?

2) When you say "just drag the formula down all the way" do you mean select all the cells in column B next to the ones you want answers for, and then enter =ExtractEmail(A1:A5) and hit enter? Because when I do that I get #VALUE!

The problem is the Excel Fox has an "error" (of sorts) in the code he posted. This the code he posted and that you are using...

Function ExtractEmail(strInputText As String) As String
    Dim regEx As Object
    Dim varResults As Object
    Dim varEach
    Dim lng As Long
    Set regEx = CreateObject("vbscript.RegExp")
    regEx.Pattern = "(?:[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*|""(?:[\x01-\x08\x0b\x0c\x0e-\x1f\x21\x23-\x5b\x5d-\x7f]|\\[\x01-\x09\x0b\x0c\x0e-\x7f])*"")@(?:(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?|\[(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?|[a-z0-9-]*[a-z0-9]:(?:[\x01-\x08\x0b\x0c\x0e-\x1f\x21-\x5a\x53-\x7f]|\\[\x01-\x09\x0b\x0c\x0e-\x7f])+)\])"
    regEx.IgnoreCase = True 'True to ignore case
    regEx.Global = True 'True matches all occurances, False matches the first occurance
    If regEx.Test(Range("D1").Value) Then
        Set varResults = regEx.Execute(Range("D1").Value)
        For lng = 1 To varResults.Count
            ExtractEmail = ExtractEmail & varResults.Item(0).Value & "|||"
        Next
        ExtractEmail = Left(ExtractEmail, Len(ExtractEmail) - Len("|||"))
        ExtractEmail = Join(Split(ExtractEmail, "|||"), ", ")
    End If
    
End Function

I highlighted the problem in red. Apparently, Excel Fox tested his code using a direct reference to cell D1, then when he converted it to a function for posting, he forgot to change those two references to the argument name used in the function's declaration header (strInputText)... just replace both red highlighted text with strInputText and the code should work fine. Just wondering if you tested my code or not (it would have worked directly).