VBA To Extract Email Address From Text

[dunndealpr]

I go to Visual Basic - Insert - New Module, I paste the code then I hit F5 then i get this prompt (see attached)Untitled-1 copy.jpg

[Rick Rothstein]

I go to Visual Basic - Insert - New Module, I paste the code then I hit F5 then i get this prompt (see attached)

The installation part (where you paste it) is correct, but as I said previously, what you pasted is not a macro... it is a function and you it just like any other function in VB. For example, you have no problem using, say, the Int function, do you? My guess is no... just do the same thing with either my function or the one Excel Fox posted, but use the name of whichever function you pasted instead of Int. Functions, whether built-in or written by me, Excel Fox, or any one else, all do the same thing... they usually (but not always) let you pass in values (called arguments) and the all return a value which can be used directly inside an expression (in VBA) or in a formula in a worksheet cell.

[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]

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]

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