How to extract an email from a text field

Hi!
Is there a way that I can extract an email adress from a text field and put it in a new table?
Something like everything between the "@" that contain no space?
Thanks!
polycorjspAsked:
Who is Participating?
 
Patrick MatthewsConnect With a Mentor Commented:
Assuming that your email address contains only numbers, digits, underscores, and dashes, add the UDF below
to a regular module, and then use it in a query like this:

SELECT RegExpFind(TextColumn, "[a-z0-9_-\.]+@([a-z0-9_-]\.){1,}[a-z0-9_-]+", 1, False)
FROM SomeTable



Function RegExpFind(LookIn As String, PatternStr As String, Optional Pos, _
    Optional MatchCase As Boolean = True) 
    ' For more info see: http://vbaexpress.com/kb/getarticle.php?kb_id=841 
    ' This function uses Regular Expressions to parse a string (LookIn), and return matches to a
    ' pattern (PatternStr).  Use Pos to indicate which match you want:
    ' Pos omitted               : function returns a zero-based array of all matches
    ' Pos = 0                   : the last match
    ' Pos = 1                   : the first match
    ' Pos = 2                   : the second match
    ' Pos = <positive integer>  : the Nth match
    ' If Pos is greater than the number of matches, is negative, or is non-numeric, the function
    ' returns an empty string.  If no match is found, the function returns an empty string
    
    ' If MatchCase is omitted or True (default for RegExp) then the Pattern must match case (and
    ' thus you may have to use [a-zA-Z] instead of just [a-z] or [A-Z]).
    
    ' If you use this function in Excel, you can use range references for any of the arguments.
    ' If you use this in Excel and return the full array, make sure to set up the formula as an
    ' array formula.  If you need the array formula to go down a column, use TRANSPOSE()
    
    Dim RegX As Object
    Dim TheMatches As Object
    Dim Answer() As String
    Dim Counter As Long
    
    ' Evaluate Pos.  If it is there, it must be numeric and converted to Long
    If Not IsMissing(Pos) Then
        If Not IsNumeric(Pos) Then
            RegExpFind = ""
            Exit Function
        Else
            Pos = CLng(Pos)
        End If
    End If
    
    ' Create instance of RegExp object
    Set RegX = CreateObject("VBScript.RegExp")
    With RegX
        .Pattern = PatternStr
        .Global = True
        .IgnoreCase = Not MatchCase
    End With
        
    ' Test to see if there are any matches
    If RegX.test(LookIn) Then
        
        ' Run RegExp to get the matches, which are returned as a zero-based collection
        Set TheMatches = RegX.Execute(LookIn)
        
        ' If Pos is missing, user wants array of all matches.  Build it and assign it as the
        ' function's return value
        If IsMissing(Pos) Then
            ReDim Answer(0 To TheMatches.Count - 1) As String
            For Counter = 0 To UBound(Answer)
                Answer(Counter) = TheMatches(Counter)
            Next
            RegExpFind = Answer
        
        ' User wanted the Nth match (or last match, if Pos = 0).  Get the Nth value, if possible
        Else
            Select Case Pos
                Case 0                          ' Last match
                    RegExpFind = TheMatches(TheMatches.Count - 1)
                Case 1 To TheMatches.Count      ' Nth match
                    RegExpFind = TheMatches(Pos - 1)
                Case Else                       ' Invalid item number
                    RegExpFind = ""
            End Select
        End If
    
    ' If there are no matches, return empty string
    Else
        RegExpFind = ""
    End If
    
    ' Release object variables
    Set RegX = Nothing
    Set TheMatches = Nothing
    
End Function

Open in new window

0
 
DatabaseMX (Joe Anderson - Microsoft Access MVP)Database ArchitectCommented:
Can you give some before and after examples?  

You want to move this from one table to another ?

mx
0
 
polycorjspAuthor Commented:
For exemple:
"The email adress name.surname@company.com don't exist."
I would like to extract "name.surname@company.com " and put it in another table

Thanks
0
Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
polycorjspAuthor Commented:
another exemple:
This Message was undeliverable due to the following reason:

Your message was not delivered because the destination computer refused to accept it (the error message is reproduced below).  This type of error is usually due to a mis-configured account or mail delivery system on the destination computer; however, it could be caused by your message since some mail systems refuse messages with invalid header information, or if they are too large.

Your message was rejected by mx1c9.bellcanadahosting.com for the following reason:

     5.7.1 mA8NUEDm007560 This message does not comply with required standards.

The following recipients did not receive this message:

     <adent@synergiscapital.com>
0
 
DatabaseMX (Joe Anderson - Microsoft Access MVP)Database ArchitectCommented:
Seems like there are a LOT of different cases ... not seeing a simple way to cover all cases.

mx
0
 
polycorjspAuthor Commented:
Most of the case are between <>; can this help?
0
 
HoggZillaCommented:
Here is some starting material:
http://www.meadinkent.co.uk/acc-instr.htm 

Dim SearchString, SearchChar, MyAtPos, MyStartPos, MyEndPos, FoundEmailString
SearchString = "This Message was undeliverable due to the following reason: Your message was not delivered because the destination computer refused to accept it (the error message is reproduced below).  This type of error is usually due to a mis-configured account or mail delivery system on the destination computer; however, it could be caused by your message since some mail systems refuse messages with invalid header information, or if they are too large. Your message was rejected by mx1c9.bellcanadahosting.com for the following reason: 5.7.1 mA8NUEDm007560 This message does not comply with required standards. The following recipients did not receive this message: <adent@synergiscapital.com>" ' String to search in.
SearchChar = "@"    ' Search for "@".
 
' A textual comparison starting at position 1. Returns 1326.
MyAtPos = Instr(1, SearchString, SearchChar, 1)   

Open in new window

0
 
polycorjspAuthor Commented:
matthewspatrick:  When i'm trying the querry; I've got this error message
Run-time error '5021':
Application-defined or object-defined error
Any idea why?
0
 
Patrick MatthewsCommented:
polycorjsp,

1) Which line, if any, does the debugger jump to?
2) How are you using the function, exactly?

Regards,

Patrick
0
 
polycorjspAuthor Commented:
Error Line if RegX
Error.png
0
 
Patrick MatthewsCommented:
polycorjsp,

My apologies for not following up sooner.  If you are no longer interested in pursuing this question, please
use the delete link to start the process of deleting the question.

If you are still interested in pursuing it, please paste back the exact SQL you tried to use.

Regards,

Patrick
0
 
polycorjspAuthor Commented:
Hi,
Sorry about this issue.  Can we start all over?
I have done a mailing to 15,000 customer.  I have receive a lot of mail delivery report saying that the email is not valid.  I have exported everything to a Database (.mdb).  Almost all the rejected email are between "< and  >"  example:  <john.smith@aol.com>. Is there a function that can be use to extract everything between < and >?  Find < take everyting until > and put it in a table.

Hope I was clear!

Thanks!
0
 
Jeffrey CoachmanConnect With a Mentor MIS LiasonCommented:
Try the code found here:
http://www.devx.com/vb2themax/Tip/19421

It finds the text between two delimiters

JeffCoachman
0
 
polycorjspAuthor Commented:
Hi Jeff,

I will try your code soon.  Thanks!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.