INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

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.

Jobs

Extract an email address from Comments field

Extract an email address from Comments field

(OP)
I have a table. It has a comments field in it. This has been used to keep email addresses in it. Unfortunately it has also been used to keep other information. (phone numbers, contact names, general notes). Is there a way to extract the email addresses without doing a manual C&P? With the email addresses being different lengths and at different places in the box, I am at a loss as to how to accomplish this.

Thanks

RE: Extract an email address from Comments field

Are there any other "@" symbols in the field other than in the email addresses?

Duane
Hook'D on Access
MS Access MVP

RE: Extract an email address from Comments field

(OP)
Not that I am aware of.

RE: Extract an email address from Comments field

You could then use a function that uses regular expressions. It could find any string that contains a @ and then return the Match collection of all of these strings. Once you find it what yould you do with the results?

RE: Extract an email address from Comments field

(OP)
I am planning on putting the email addresses in their own text field.

RE: Extract an email address from Comments field

You could use a user-defined function like:

CODE --> vba

Public Function ExtractEmail(varText As Variant) As Variant
    Dim intAtAt As Integer
    Dim intChar As Integer
    Dim strChar As String
    Dim strEmail As String
    If IsNull(varText) Or InStr(varText & "", "@") = 0 Then
        ExtractEmail = Null
     Else
        intAtAt = InStr(varText, "@")
        For intChar = intAtAt To 1 Step -1
            strChar = Mid(varText, intChar, 1)
            If strChar = " " Then
                Exit For
             Else
                strEmail = strChar & strEmail
            End If
        Next
        For intChar = intAtAt To Len(varText)
            strChar = Mid(varText, intChar, 1)
            If strChar = " " Then
                Exit For
             Else
                strEmail = strEmail & strChar
            End If
        Next
    End If
    ExtractEmail = strEmail
End Function 

In a query, this might look like

CODE --> SQL

Email: ExtractEmail([Comments Field]) 

Duane
Hook'D on Access
MS Access MVP

RE: Extract an email address from Comments field

I interpreted this to mean multiple emails. You could then wrap Duane's function with another function to iterate through each @ character.
You can also use regular expressions to find all of the emails and return a collection. Then decide what you want to do with them.

CODE

Public Function ReturnMatches(strWord As String) As VBScript_RegExp_55.MatchCollection
  'This function returns a collection of emails found in a string
  'Need Microsoft VBScript Regular Expressions
   Dim objRegExp As VBScript_RegExp_55.RegExp
   Dim objMatch As VBScript_RegExp_55.match
   Dim myPattern As String

   'Match for all emails
   myPattern = "([a-zA-Z0-9._-]+@[a-zA-Z0-9._-]+\.[a-zA-Z0-9._-]+)"
  'Create a regular expression object.
   Set objRegExp = New RegExp
  'Set the pattern by using the Pattern property.
   objRegExp.Pattern = myPattern
  'Set Case Insensitivity.
   objRegExp.ignorecase = False
  'Set global applicability. Not sure what that does
   objRegExp.Global = True
  'Test whether the String can be compared. Not sure what that does
  If (objRegExp.test(strWord) = True) Then
     Set ReturnMatches = objRegExp.Execute(strWord)   ' Execute search.
     'lets assume you only get one match
   Else
     Debug.Print "Could not compare string"
   End If
 '
End Function 

This examples uses the collection to read the records and write to a new field in a format seperated by a semicolon. If you are in fact getting multiple emails you would want to more likely save in a child table.

CODE

Public Sub ExtractEmails()
  Const tableName = "tblComments"
  Const oldField = "Comment"
  Const newField = "Emails"
  Dim rs As dao.Recordset
  Dim oldComment As String
  Dim emails As VBScript_RegExp_55.MatchCollection
  
  
  Set rs = CurrentDb.OpenRecordset(tableName)
  'loop the recordset
  Do While Not rs.EOF
    oldComment = rs.Fields(oldField)
    Set emails = ReturnMatches(oldComment)
    If Not emails Is Nothing Then
      rs.Edit
        rs.Fields(newField) = GetStringEmails(emails)
      rs.Update
    End If
    rs.MoveNext
  Loop
 
 End Sub

Public Function GetStringEmails(emails As VBScript_RegExp_55.MatchCollection) As String
  'send in a collection and send out a concatenated string
  Dim email As VBScript_RegExp_55.match
  For Each email In emails
      If GetStringEmails = "" Then
        GetStringEmails = email
      Else
        GetStringEmails = GetStringEmails & "; " & email
      End If
  Next email
End Function 

Here is a test

CODE

jeligarrewa-8453@yopmail.com    The brief sound clarifys the approval oppobobett-7308@yopmail.com The linen boughts the sand stone@meekness.com The cooing manager begins the cough.  ca-tech@dps.centrin.net.id  and then there was trinanda_lestyowati@telkomsel.co.id 
and the output in the table looked like this

CODE

jeligarrewa-8453@yopmail.com; 
oppobobett-7308@yopmail.com; 
stone@meekness.com; 
ca-tech@dps.centrin.net.id; 
trinanda_lestyowati@telkomsel.co.id 

RE: Extract an email address from Comments field

(OP)
Thanks for this, both of you.

RE: Extract an email address from Comments field

MajP and Duane gave you an excellent solution. They deserve stars for their effort, don’t you think?

Have fun.

---- Andy

A bus station is where a bus stops. A train station is where a train stops. On my desk, I have a work station.

RE: Extract an email address from Comments field

(OP)
I finally am able to try this. Couple issues;
The Extracted Emails have two @ symbols. so JohnDoe@domain.com returns JohnDoe@@domain.com
Some fields don't extract correctly and example is;
In the MemComments field (A memo field)
SOCHE
VICTOR MORANO
1continentalexpress@gmail.com

Returns: MORANO

In the MemComments field:
(206) 422-5540

umidcfalogistics@gmail.com

Returns: 422-5540

Now I think can fix this on my own by removing the carriage returns and just replace @@ with @ but I wanted to post here so you would know the results. I used Dhookum's code.

RE: Extract an email address from Comments field

Should fix it.

CODE -->

Public Function ExtractEmail(varText As Variant) As Variant
    Dim intAtAt As Integer
    Dim intChar As Integer
    Dim strChar As String
    Dim strEmail As String
    If IsNull(varText) Or InStr(varText & "", "@") = 0 Then
        ExtractEmail = Null
     Else
        intAtAt = InStr(varText, "@")
        For intChar = intAtAt To 1 Step -1
            strChar = Mid(varText, intChar, 1)
            If strChar = " " Or strChar = Chr(10) Or strChar = Chr(13) Then
                Exit For
             Else
                strEmail = strChar & strEmail
            End If
        Next
        For intChar = intAtAt To Len(varText)
            strChar = Mid(varText, intChar, 1)
            If strChar = " " Or strChar = Chr(10) Or strChar = Chr(13) Then
                Exit For
             Else
                strEmail = strEmail & strChar
            End If
        Next
    End If
    ExtractEmail = Replace(strEmail, "@@", "@")
End Function 

RE: Extract an email address from Comments field

I tested my code in the following query

CODE

SELECT tblData.MemoFld, 
 getEmails([memofld]) AS Emails
FROM tblData; 

CODE -->

Public Function GetEmails(varText As Variant) As String
  Dim Emails As VBScript_RegExp_55.MatchCollection
  If Not IsNull(varText) Then
    Set Emails = ReturnMatches(CStr(varText))
    GetEmails = GetStringEmails(Emails)
  End If
End Function
Public Function ReturnMatches(strWord As String) As VBScript_RegExp_55.MatchCollection
  'This function returns a collection of emails found in a string
  'Need Microsoft VBScript Regular Expressions
   Dim objRegExp As VBScript_RegExp_55.RegExp
   Dim objMatch As VBScript_RegExp_55.match
   Dim myPattern As String

   'Match for all emails
   myPattern = "([a-zA-Z0-9._-]+@[a-zA-Z0-9._-]+\.[a-zA-Z0-9._-]+)"
  'Create a regular expression object.
   Set objRegExp = New RegExp
  'Set the pattern by using the Pattern property.
   objRegExp.Pattern = myPattern
  'Set Case Insensitivity.
   objRegExp.ignorecase = False
  'Set global applicability. Not sure what that does
   objRegExp.Global = True
  'Test whether the String can be compared. Not sure what that does
  If (objRegExp.test(strWord) = True) Then
     Set ReturnMatches = objRegExp.Execute(strWord)   ' Execute search.
     'lets assume you only get one match
   Else
     Debug.Print "Could not compare string"
   End If
 '
End Function
Public Function GetStringEmails(Emails As VBScript_RegExp_55.MatchCollection) As String
  'send in a collection and send out a concatenated string
  Dim email As VBScript_RegExp_55.match
  For Each email In Emails
      If GetStringEmails = "" Then
        GetStringEmails = email
      Else
        GetStringEmails = GetStringEmails & "; " & email
      End If
  Next email
End Function 

It handles both of those cases and can handle the combined case where they are both in the same memo field.

CODE -->

MemoFld                                Emails

"SOCHE                                1continentalexpress@gmail.com; umidcfalogistics@gmail.com
VICTOR MORANO
1continentalexpress@gmail.com 
(206) 422-5540
 
umidcfalogistics@gmail.com
 
Returns: 422-5540" 

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!

Resources

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