VBA Tips - Validando endereços de eMail - Validate E-mail Addresses

| Blog Office VBA | Blog Excel | Blog Access |

Imagine que você tenha um banco de dados enorme, cheio de endereços de email, ou que você tenha copiado uma página da web que tinha endereços de correio eletrônico com textos desnecessários e você queira destacar as ocorrências inválidas ou extrair os endereços válidos de e-mail deles.

Function CheckEmail(ByVal EmailAddress As String)

    Dim sArray As Variant, sItem As Variant

    Dim n As Long, c As String

    'Find the number of @, it should be exactly one.

    n = Len(EmailAddress) - Len(Application.Substitute(EmailAddress, "@", ""))

    If n <> 1 Then CheckEmail = False: Exit Function

    ReDim sArray (1 To 2)

    sArray (1) = Left(EmailAddress, InStr(1, EmailAddress, "@", 1) - 1)

    sArray (2) = Application.Substitute(Right(EmailAddress, Len(EmailAddress ) - Len(sArray(1))), "@", "")

    For Each sItem In sArray

        'There should be atleast one character before @.

        If Len(sItem) <= 0 Then CheckEmail = False: Exit Function

        For n = 1 To Len(sItem)

            c = LCase(Mid(sItem, n, 1))

                       

            If InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 And Not IsNumeric(c)  Then CheckEmail = False: Exit Function

        Next

        'Extreme characters must not be period or dot (.)

        If Left(sItem, 1) = "." Or Right(sItem, 1) = "."  Then CheckEmail = False: Exit Function

     Next

    'There must be atleast one period or dot after @

    If InStr(sArray(2), ".") <= 0  Then CheckEmail = False: Exit Function

    'After the last dot or period, there must be either exactly 2 or 3 characters.

    n = Len(sArray(2)) - InStrRev(sArray(2), ".")

    If n <> 2 And n <> 3  Then CheckEmail = False: Exit Function

    'It must not contain 2 or more consecutive periods or dots.

    If InStr(EmailAddress, "..") > 0  Then CheckEmail = False: Exit Function

    CheckEmail = True

End Function

Tags: VBA, email, e-mail, address, addresses, validate, validando