VBA To Extract Email Address From Text

[dunndealpr]

Got it. So once I've pasted the code into a module, what do I do to run it?

[Rick Rothstein]

You do not run functions (you run macros), you use functions to return a value to you. Once you have pasted (I'll assume my code because I'll be using my function's name below) into the module, go to any worksheet and put this in cell A1...

This is a test line with this (one.two@three.four.com) strange email address

Now, put this in cell A2 and I think all will become clear (well, I hope so because I am going to sleep now)...

=GetEmailAddress(A1)

[dunndealpr]

Hey Rick, I got an email seeing your last reply to this thread but I don't see it anywhere on the actual thread. Weird...

Anyway, I can insert module and paste script just fine. It's the actual running of it that eludes me. I press F5 and the Macros window comes up.

[dunndealpr]

I see now! It's working! Thanks for your patience. Last stupid question. What do I enter in place of A1 to make this script run on multiple rows?

[Excel Fox]

Just drag the formula down all the way

[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).

[bakerman]

@ Rick

See post #19

[snb]

An alternative approach, see the attachment