✔ VBA Excel Specialist®: Extrair eMails

Function ExtractEmailAddress(s As String) As String

' Author: Date: Contact:
' André Bernardes 11/08/2008 09:01 bernardess@gmail.com
' Extrai apenas o e-mail de uma célula.

Dim AtSignLocation As Long
Dim i As Long
Dim TempStr As String
Const CharList As String = "[A-Za-z0-9._-]"

'Localizando a @.

Let AtSignLocation = InStr(s, "@")

If AtSignLocation = 0 Then
Let ExtractEmailAddress = "" 'not found
Else
Let TempStr = ""

'Parte do e-mail antes da @.
For i = AtSignLocation - 1 To 1 Step -1
If Mid(s, i, 1) Like CharList Then
Let TempStr = Mid(s, i, 1) & TempStr

Else
Exit For
End If
Next i

If TempStr = "" Then Exit Function

'Parte do e-mail depois da @.

Let TempStr = TempStr & "@"

For i = AtSignLocation + 1 To Len(s)
If Mid(s, i, 1) Like CharList Then
Let TempStr = TempStr & Mid(s, i, 1)

Else
Exit For
End If
Next i
End If

'Remove trailing period if it exists
If Right(TempStr, 1) = "." Then _

Let TempStr = Left(TempStr, Len(TempStr) - 1)

Let ExtractEmailAddress = TempStr
End Function

Tags: VBA, Tips, UDF, e-mail, eMail,

✔ VBA Excel Specialist®

Meni

Views

...

Important:

E-mails

eBook Promo

Extrair eMails

O que é o fenômeno chamado BIG DATA?

eBooks VBA na AMAZOM.com.br

LinkWithinBrazilVBAExcelSpecialist

Vitrine