extract email from large text file

[KO_Baystate]

I am trying to find a way to extract an email from a large text file that is an output from our email system. I would like to be able to extract the email address using a query or collection of queries. I have been able to extract all of the text that contains the @ symbol. From their I created a query expression:IE: Mid([field1],InStrRev([field1]," ")) that captures some but not everything I need. The "testdata" file is the raw text file and "testdata1" is the output after I imported the text file into Access, ran a query to only include lines with the "@" symbol and then ran the expression IE: Mid([field1],InStrRev([field1]," "))


Thanks

Kevin

[orange]

What is the objective of all this parsing? What are you going to do with the output?

[KO_Baystate]

Hi there,

I work for a promotional products company that sends out a newsletter to subscribed customers only. We sometimes get responses from the email newsletters providing alternative email addresses that we would like to add to our list email list. I can assure you that this isn't to spam or provide newsletters to people that don't want them. I don't know what assurances I could provide you to make this seem like this isn't for malicious purposes. To give everyone a better idea of what i mean by promotional products here is the website for the business i work for:http://www.baystate.com/

[orange]

No, I wasn't trying to see if this was spam related. I wondered if you were vetting email addresses with clients or similar. Or putting these into a table -- I was wondering where other things like Name, Address,Phone would come from or be matched.
Are you a programmer --vba?

[KO_Baystate]

Thanks for your response. The reason I thought you might be hinting at spamming or something similar is that I have seen the topic come up in other forums that have touched on this subject. I would describe the purpose as vetting emails to some extent but I don't think it will be matched with other information in any other tables. The proposed output will be compared to other emails already existing in the table and will be added if they aren't already existing. I haven't done programming for a very long time but I tried to approach this problem using vba. Even so, I am interested in finding a solution using Access if possible. I have changed the expression I was using slightly to Expr1: Mid([field1],InStrRev([field1]," ",InStr([field1],"@")+1)). this expression works okay but i'd like to be able to remove all the text from the in front of and behind the email address. The email addresses are bracketed by these characters <, >, (, ), ", .

[orange]

I created a function that will pull email addresses out of an input string. It uses regular expressions (regex) which is based on pattern matching. I am including it here, along with a test routine I created that uses some of your test data with a few adjustments. I've added extra email addresses separated by spaces within some of the test data records.

If you decide to use (or adjust to your needs) the function, you need to have a reference to the Microsoft VBScript Regular Expression library. Regex is great for pattern matching, but there is nothing wrong with the Mid(),InStr(),InStrRev(),Left(),Right(), Trim() functions either.

I could not find a good example using Access vba where there was a search and extract of matches to a pattern. So this will serve as a sample.

'---------------------------------------------------------------------------------------
' Procedure : Emailfinder
' Author    : Jack
' Date      : 18/02/2014
' Purpose   : This will get valid email addresses from a atring. [Valid == matches the pattern]
'  Found "best regex pattern for email validation" at
'  http://blog.trojanhunter.com/2012/09/26/the-best-regex-to-validate-an-email-address
' Pattern:  [-0-9a-zA-Z.+_]+@[-0-9a-zA-Z.+_]+\.[a-zA-Z]{2,4}
'
' This routine will return multiple email addresses when there are multiples in the string.
'
''                                ---------------------------------------
'*** Requires a reference to the  Microsoft VBScript Regular Expressions  library
'                                 _______________________________________
'---------------------------------------------------------------------------------------
'
Function Emailfinder(T As String) As String
          Dim MyRE As Object
10        Set MyRE = New Regexp
          Dim MyMatches As MatchCollection
          Dim MyResult As String
          'set the email pattern
20        On Error GoTo Emailfinder_Error
30        Emailfinder = ""  'set to empty string
40        MyRE.Pattern = "[-0-9a-zA-Z.+_]+@[-0-9a-zA-Z.+_]+\.[a-zA-Z]{2,4}"
50        MyRE.Global = True
60        MyRE.ignorecase = True
70        Set MyMatches = MyRE.Execute(T)
80        If MyMatches.Count > 0 Then
90            For Each MyMatch In MyMatches
100               MyResult = MyResult & MyMatch.Value & vbCrLf
110           Next
120           Emailfinder = MyResult  ' one or more valid email addresses
130       Else
140           Emailfinder = ""    'empty string
150       End If
160       On Error GoTo 0
170       Exit Function

Emailfinder_Error:

180       MsgBox "Error " & Err.number & " (" & Err.Description & ") in procedure Emailfinder of Module Module1"
End Function

Here is the test routine I used that includes some of your test data.

Sub sometest()
    Dim s(14) As String 'test data
    Dim i As Integer
   On Error GoTo sometest_Error

    s(0) = "h="
    s(1) = " 1="
    s(2) = " 10pt;>.</span></p>=jim.XX@samoa.net.au<p= ==mmgf  hank@gmail.com gerry@Att.net"
    s(3) = "(301)277-="
    s(4) = " <test@oceanfire.com;bill@gmail.com>"
    s(5) = "<test@oceanfire.com>;"
    s(6) = "Test@ promotioncorner.com"
    s(7) = "<test@oceanfire.com>"
    s(8) = "<20140206130446.BB05F2995@diligence.cnchost.com>"
    s(9) = "<test@promotioncorner.com>"
    s(10) = "<test@wadecorporategifts.com>"
    s(11) = "<0Lh8Cl-1VPCF507ZX-00oYM5@mx.perfora.net>"
    s(12) = "<test@vectorpromo.com>"
    s(13) = "-0500"
    s(14) = " Test@ promotioncorner.com"

    For i = 0 To UBound(s)
        If Emailfinder(s(i)) <> "" Then
            Debug.Print Emailfinder(s(i)) & "  " & i
        End If
    Next i

   On Error GoTo 0
   Exit Sub

sometest_Error:

    MsgBox "Error " & Err.number & " (" & Err.Description & ") in procedure sometest of Module Module1"
End Sub

Output"

jim.XX@samoa.net.au
hank@gmail.com
gerry@Att.net
  2
test@oceanfire.com
bill@gmail.com
  4
test@oceanfire.com
  5
test@oceanfire.com
  7
20140206130446.BB05F2995@diligence.cnchost.com
  8
test@promotioncorner.com
  9
test@wadecorporategifts.com
  10
0Lh8Cl-1VPCF507ZX-00oYM5@mx.perfora.net
  11
test@vectorpromo.com
  12

Good luck with your project

[KO_Baystate]

Thanks Orange!!

This looks like it will work!!

[orange]

No problem. Happy to help. Post back if you need something.

[ItsMe]

Nice use of the string array Orange