Views

...

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.

E-mails

Deixe seu e-mail para receber atualizações...

eBook Promo

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

Inline image 1


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

TagsVBA, email, e-mail, address, addresses, validate, validando


eBooks VBA na AMAZOM.com.br

LinkWithinBrazilVBAExcelSpecialist

Related Posts Plugin for WordPress, Blogger...

Vitrine