Page 3 of 5 FirstFirst 12345 LastLast
Results 21 to 30 of 44

Thread: VBA To Extract Email Address From Text

  1. #21
    Moderator
    Join Date
    Jul 2012
    Posts
    156
    Rep Power
    13
    @ Rick

    See post #19

  2. #22
    Senior Member
    Join Date
    Jun 2012
    Posts
    337
    Rep Power
    13
    An alternative approach, see the attachment
    Attached Files Attached Files

  3. #23
    Forum Guru Rick Rothstein's Avatar
    Join Date
    Feb 2012
    Posts
    662
    Rep Power
    13
    Quote Originally Posted by snb View Post
    An alternative approach, see the attachment
    Your code uses spaces as the delimiter which means that for text like this...

    testing (jill@gmail.com) this

    it returns this...

    (jill@gmail.com)

    rather than this...

    jill@gmail.com

    And, of course, it will retain other adjacent non-email-characters as well. If you look at the code I posted, those characters are not retained with the email address itself.

  4. #24
    Junior Member
    Join Date
    Jun 2013
    Posts
    22
    Rep Power
    0
    hey Rick. Just tried yours and snb's and they both work, thank you again. What I'm still stumped on is how to make it work for multiple rows at once.

    An earlier commenter said "just drag the formula down all the way". Does that 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!

  5. #25
    Forum Guru Rick Rothstein's Avatar
    Join Date
    Feb 2012
    Posts
    662
    Rep Power
    13
    Quote Originally Posted by dunndealpr View Post
    hey Rick. Just tried yours and snb's and they both work, thank you again.
    Look at Message #23 where I advise that snb's posted function does not remove punctuation marks next to the email address (my guess is you tested his function with a simple text string where the email address stood alone surrounded only be spaces.


    Quote Originally Posted by dunndealpr View Post
    What I'm still stumped on is how to make it work for multiple rows at once.

    An earlier commenter said "just drag the formula down all the way". Does that 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!
    Assuming you have text in A1 to, say, A10, put the formula in B1 and, with B1 selected, hover your cursor over the small black square in the bottom right corner of B1 (the selected cell) until the cursor becomes what looks like a plus sign, then click and drag down to B10... the address references in the formula will automatically adjust for their new location. You can achieve the same result by selecting B1 (after you put the formula in it), copying it, then selecting B1:B10 and pasting.

  6. #26
    Junior Member
    Join Date
    Jun 2013
    Posts
    22
    Rep Power
    0
    Holy cow. It works! I cannot thank you guys enough. I hope you're rich.

    Thank you again.

  7. #27
    Administrator Excel Fox's Avatar
    Join Date
    Mar 2011
    Posts
    1,402
    Rep Power
    10
    For posterity, the 'bazooka' function uses a heavy-duty regular expression (it was Rick who coined it that way in one of our threads, so I'll pass the credit to him for the catchy name).

    Just for the record though, the function that I posted (revised one below) will extract more than one email address from the string, should it contain that many.

    Code:
    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(lng - 1).Value & "|||"
            Next
            ExtractEmail = Left(ExtractEmail, Len(ExtractEmail) - Len("|||"))
            ExtractEmail = Join(Split(ExtractEmail, "|||"), ", ")
        End If
        End With
    End Function
    A dream is not something you see when you are asleep, but something you strive for when you are awake.

    It's usually a bad idea to say that something can't be done.

    The difference between dream and aim, is that one requires soundless sleep to see and the other requires sleepless efforts to achieve

    Join us at Facebook

  8. #28
    Forum Guru Rick Rothstein's Avatar
    Join Date
    Feb 2012
    Posts
    662
    Rep Power
    13
    Quote Originally Posted by Excel Fox View Post
    Just for the record though, the function that I posted (revised one below) will extract more than one email address from the string, should it contain that many.
    Excellent idea Excel Fox! Here is my code modified to do the same thing...
    Code:
    Function GetEmailAddress(Sin As String) As String
      Dim X As Long, AtSign As Long, AtSign2 As Long, StartAt As Long, S As String, subS As String
      Dim Locale As String, Domain As String
      Locale = "[A-Za-z0-9.!#$%&'*/=?^_`{|}~+-]"
      Domain = "[A-Za-z0-9._-]"
      StartAt = 1
      Do
        S = Mid(Sin, StartAt)
        AtSign = InStr(StartAt, S, "@")
        If AtSign < 2 Then Exit Do
        If Mid(S, AtSign - 1, 1) Like Locale Then
          For X = AtSign To 1 Step -1
            If Not Mid(" " & S, X, 1) Like Locale Then
              subS = Mid(S, X)
              If Left(subS, 1) = "." Then subS = Mid(subS, 2)
              Exit For
            End If
          Next
          AtSign2 = InStr(subS, "@")
          For X = AtSign2 + 1 To Len(subS) + 1
            If Not Mid(subS & " ", X, 1) Like Domain Then
              subS = Left(subS, X - 1)
              If Right(subS, 1) = "." Then subS = Left(subS, Len(subS) - 1)
              GetEmailAddress = GetEmailAddress & ", " & subS
              Exit For
            End If
          Next
        End If
        StartAt = AtSign + 1
      Loop
      GetEmailAddress = Mid(GetEmailAddress, 3)
    End Function

  9. #29
    Senior Member
    Join Date
    Jun 2012
    Posts
    337
    Rep Power
    13
    I assumed the OP had email addresses in sentences, so I assumed every email address being encapsulated by spaces. Based on his feedback I conclude my assumption was correct.
    So I won't try to match Rick's 'overkill' () code. Sufficient is enough I'd say

  10. #30
    Forum Guru Rick Rothstein's Avatar
    Join Date
    Feb 2012
    Posts
    662
    Rep Power
    13
    Quote Originally Posted by snb View Post
    I assumed the OP had email addresses in sentences, so I assumed every email address being encapsulated by spaces. Based on his feedback I conclude my assumption was correct.
    From the OP's posting in Message #3...

    "Add to that, a lot of people I know don't exactly follow proper writing rules, so there might be a character pressed right up against the beginning or the end of their email address with no space. A lot of people end the sentence with their email address, meaning there's a period at the end of .com."

Similar Threads

  1. VBA Code to email using Globals Address Book
    By cdurfey in forum Excel Help
    Replies: 5
    Last Post: 05-28-2013, 10:25 PM
  2. Replies: 6
    Last Post: 05-25-2013, 07:36 PM
  3. Replies: 2
    Last Post: 05-23-2013, 08:08 AM
  4. Replies: 2
    Last Post: 03-21-2013, 08:51 PM
  5. Extract Email Text to Excel
    By bcloring in forum Excel Help
    Replies: 5
    Last Post: 12-14-2012, 04:10 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •