Re: Extract email addresses

Because of a difference in the VBA flavor of Regular Expressions, the following
formula should work better:

=remid(A1,"\b\S+@[^ \f\n\r\t\v\xA0]+")

or

=remid(A1,"\b\S+@[^ \f\n\r\t\v\x80-\xFF]+")

The issue has to do with handling of characters with an ASCII value > 127 by
the \S token.





On Fri, 15 Dec 2006 07:52:25 -0500, Ron Rosenfeld <ronrosenfeld@xxxxxxxxxx>
wrote:

On Fri, 15 Dec 2006 09:20:03 -0000, <Andy> wrote:

Hi

I have been looking for an answer to this for weeks - and I admit defeat!
I have a column of data with email addresses in there, somewhere. Each email
is preceeded and followed by a space. There are also non-printing 'squares'
in there - but I'm not sure if that makes a difference or not!
Sample text could be
This message has been returned .. . . address was xxxxxxxx@xxxxxxxxx and
this address . . . . . etc

So I am trying to extract the section of text with the @ sign, up to but
excluding the spaces at both ends.
Help me, please!
Andy.


You can do it using Regular Expressions. These can be implemented in VBA or
with an add-in.

To implement it in VBA, <alt-F11> opens the VB Editor.

Ensure your project is highlighted in the Project Explorer window.
Insert/Module and paste the code below into the window that opens.
From the top menu, Tools/References and select Microsoft VBScript Regular
Expressions 5.5.

Then try this formula:

=remid(A1,"\b\S+@\S+(?=\s)")

===========================================
Option Explicit

Function REMid(str As String, Pattern As String, _
Optional Index As Variant = 1, _
Optional CaseSensitive As Boolean = True) _
As Variant 'Variant as value may be string or array

Dim objRegExp As RegExp
Dim objMatch As Match
Dim colMatches As MatchCollection

Dim i As Long 'counter
Dim t() As String 'container for array results

' Create a regular expression object.
Set objRegExp = New RegExp

'Set the pattern by using the Pattern property.
objRegExp.Pattern = Pattern

' Set Case Insensitivity.
objRegExp.IgnoreCase = Not CaseSensitive

'Set global applicability.
objRegExp.Global = True

'Test whether the String can be compared.
If (objRegExp.Test(str) = True) Then

'Get the matches.
Set colMatches = objRegExp.Execute(str) ' Execute search.

On Error Resume Next 'return null string if a colmatch index is non-existent
If IsArray(Index) Then
ReDim t(1 To UBound(Index))
For i = 1 To UBound(Index)
t(i) = colMatches(Index(i) - 1)
Next i
REMid = t()
Else
REMid = CStr(colMatches(Index - 1))
If IsEmpty(REMid) Then REMid = ""
End If
On Error GoTo 0 'reset error handler
Else
REMid = ""
End If
End Function
===================================


--ron

--ron
.

Relevant Pages