View Single Post
  #8   Report Post  
Posted to microsoft.public.excel.misc
Ron Rosenfeld Ron Rosenfeld is offline
external usenet poster
 
Posts: 5,651
Default Compiling Email Addresses from Text

On Sat, 2 Feb 2008 17:50:04 -0800 (PST), iliace wrote:

If it's all in one cell on a line, then the approach needs to
different. You could potentially use Text to Columns, then use the
any of the macros supplied.


The approach also has to be different if there is anything in the cell besides
the email address; and you can also return phrases that contain @ and "." but
are not email addresses.

For example, the above paragraph in a cell would be extracted in its entirety!

Something like the code below, should extract only email addresses, even if
there are multiple addresses in each cell, and write them sequentially in a
column someplace (rDest) which could be a separate sheet.

But how this should be done really depends on information which the OP has not
yet provided.

===========================================
Option Explicit
Sub ExtractEmails()
Dim c As Range
Dim rDest As Range
Dim str As String
Dim i As Long
Dim re As Object, mc As Object, m As Object

i = 1
Set rDest = [m1]
rDest.EntireColumn.ClearContents
Set re = CreateObject("vbscript.regexp")
re.IgnoreCase = True
re.Global = True
'This regex probably complies with RFC 2822 and matches all
'country code top level domains, and specific common top level domains.
re.Pattern = "[a-z0-9!#$%&'*+/=?^_`{|}~-]+" & _
"(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*@" & _
"(?:[a-z0-9](?:[a-z0-9\-]*[a-z0-9])?\.)+" & _
"(?:[A-Z]{2}|com|org|net|gov|mil|biz|info|name" & _
"|aero|biz|info|mobi|jobs|museum)\b"
For Each c In Selection
str = c.Value
Set mc = re.Execute(str)
For Each m In mc
rDest(i, 1).Value = m.Value
i = i + 1
Next m
Next c
End Sub
=====================================
--ron