Important:

Quaisquer soluções e/ou desenvolvimento de aplicações pessoais, ou da empresa, que não constem neste Blog podem ser tratados como consultoria freelance.

Views

Histats

Vitrine

Extrair eMails



Consegue extrair um endereço de eMail de uma linha onde estejam contidos outros dados?

Veja o exemplo: 

André Luiz Bernardes <bernardess@gmail.com>

Utilize a função ExtractEmailAddress para extrair somente o endereço do e-mail.

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,




Related Posts Plugin for WordPress, Blogger...
diHITT - Notícias