×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Return first instance of email address from text

Return first instance of email address from text

Return first instance of email address from text

(OP)
Hello, I need to return just the first email address from a block of text that contains several email addresses.

I have found the following function whcih returns ALL email addresses from the block. Is there a better way (more efficient) or can this function be editied?

Many thanks
Mark

CODE -->

Public Function ExtractEmailFun(extractStr As String) As String
'Update by extendoffice
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 If
Loop
ExtractEmailFun = OutStr
End Function 

RE: Return first instance of email address from text

CODE

...
    Else
        Exit Do
    End If
Loop

If InStr(OutStr, Chr(10)) > 0 Then
    OutStr = Split(OutStr, Chr(10)) (0)
End If

ExtractEmailFun = OutStr
End Function 

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

RE: Return first instance of email address from text

> ALL email addresses from the block

Well, to be pedantic, it returns all alphanumeric (plus . and _) strings that contain an @ rather than an RFC 5322 email address. But, assuming that is good enough for your purposes, this regular expression-based function might prove useful ,as it should return all matched emails as an array of strings.

CODE

Public Function getEmails(strEmail As String) As String()
    Dim lp As Long
    Dim myMatches As Object 'MatchCollection
    Dim myStrings() As String
    
    With CreateObject("vbscript.regexp")
        .Global = True
        .Pattern = "[\w._-]+@[\w._-]+" 'v. simplistic email address matching pattern
        Set myMatches = .Execute(strEmail)
    End With
    ReDim myStrings(myMatches.Count - 1) As String
    For lp = 0 To myMatches.Count - 1
        myStrings(lp) = myMatches.Item(lp)
    Next
    getEmails = myStrings
End Function 

RE: Return first instance of email address from text

The above code from Strongm will give you a very nice list to pick from.
Cool solution smile

Herman
Say no to macros

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close