Email Address Format Validation

[anhn]

The function below will help to validate whether an Email Address is in correct format.

Private Function IsValidEmailAddress(ByVal sEmail As String, _
                                     Optional ByRef sReason As String) As Boolean
   '-- Coded by Hoang Nguyen (anhn @ VBForums)
   '-- There may be some missing conditions
   '   or I am not sure whether they are valid or not.
   '-- Not validating format like:  peter@[10.11.12.13]
   '   or email address formats with explicit source route.
   '-- PLEASE USE WITH CAUTIONS, MODIFY IT AS YOU NEED
   '-------------------------------------------------------
   sEmail = LCase(Trim(sEmail))
   'IsValidEMailAddress = False
   If Len(sEmail) < 7 Then '-- Is [email protected] a valid email address?
      sReason = "Too short"
   ElseIf sEmail Like "*[!0-9a-z@._+-]*" Then
      '-- not sure about these characters: ! $ & ` ' * / \ = ? ^ | # % { } ~
      '   if required, add in to the above string after letter z and before the last hyphen -
      sReason = "Invalid character"
   ElseIf Not sEmail Like "*@*.*" Then
      sReason = "Missing the @ or ."
   ElseIf sEmail Like "*@*@*" Then
      sReason = "Too many @"
   ElseIf sEmail Like "[@.]*" Or sEmail Like "*[@.]" _
      Or sEmail Like "*..*" Or Not sEmail Like "?*@?*.*?" Then
      sReason = "Invalid format"
   Else
      Dim n As Integer
      n = Len(sEmail) - InStrRev(sEmail, ".")
      If n > 3 Then
         sReason = "Suffix too long"
      ElseIf n < 2 Then
         sReason = "Suffix too short"
      Else
         sReason = Empty
         IsValidEmailAddress = True
      End If
   End If
End Function

[aleall]

I just made a little change to your pretty function, so that unaware or clumsy end-user can have more informations about email they type.

Private Function IsValidEmailAddress(ByVal sEmail As String, _
                                     Optional ByRef sReason As String) As Boolean
   '-- Coded by Hoang Nguyen (anhn @ VBForums)
   '-- There may be some missing conditions
   '   or I am not sure whether they are valid or not.
   '-- Not validating format like:  peter@[10.11.12.13]
   '   or email address formats with explicit source route.
   '-- PLEASE USE WITH CAUTIONS, MODIFY IT AS YOU NEED
   '-------------------------------------------------------
  
  'Made by alell: Changes for Multi-reason function for clumsy end-user ;-))
  
  sEmail = LCase(Trim(sEmail))
  'IsValidEMailAddress = False
  If Len(sEmail) < 7 Then '-- Is [email protected] a valid email address?
     sReason = "> Too short" & vbCrLf
  End If
  
  If sEmail Like "*[!0-9a-z@._+-]*" Then
     '-- not sure about these characters: ! $ & ` ' * / \ = ? ^ | # % { } ~
     '   if required, add in to the above string after letter z and before the last hyphen -
     sReason = sReason & "> Invalid character" & vbCrLf
  End If
  
  If Not sEmail Like "*@*.*" Then
     sReason = sReason & "> Missing the @ or ." & vbCrLf
  End If
  If sEmail Like "*@*@*" Then
     sReason = sReason & "> Too many @" & vbCrLf
  End If
  'Added by alell to avoid validation of "aaaa.bbbb.com"
  If sEmail Like "*.*.*" Then
     sReason = sReason & "> Too many ." & vbCrLf
  End If
  If sEmail Like "[@.]*" Or sEmail Like "*[@.]" _
     Or sEmail Like "*..*" Or Not sEmail Like "?*@?*.*?" Then
     sReason = sReason & "> Invalid format" & vbCrLf
  End If
  
  Dim n As Integer
  If InStrRev(sEmail, ".") > 0 Then
    n = Len(sEmail) - InStrRev(sEmail, ".")
    If n > 3 Then
       sReason = sReason & "> Suffix too long"
    ElseIf n < 2 Then
       sReason = sReason & "> Suffix too short"
    Else
      If sReason <> "" Then Exit Function
       sReason = Empty
       IsValidEmailAddress = True
    End If
  End If
    
End Function

Bye

[anhn]

Initial idea is the function will detect one error at a time. An email address will be failed straight away if one condition is not matched, instead of checking all conditions.

As stated, "MODIFY IT AS YOU NEED", however one feature you added that fails all non-US email addresses:

  'Added by alell to avoid validation of "aaaa.bbbb.com"
  If sEmail Like "*.*.*" Then
     sReason = sReason & "> Too many ." & vbCrLf
  End If

Have you ever received a non-US email address?
These are valid email addresses:

[email protected]
[email protected]

[golgot666]

many thanks i have aadapted it as i get a tring separated by ;

Public Function IsValidEmailAddress(ByVal strEmail As String, Optional ByRef sReason As String) As Boolean

On Error GoTo IsValidEmailAddress_Err
    
    Dim strEmailAdr As Variant
    Dim sEmail As String
    Dim i As Integer
    
    'cas if the string ends with only ;
    If InStrRev(strEmail, ";") = Len(strEmail) Then strEmail = Left(strEmail, Len(strEmail) - 1)
    strEmailAdr = Strings.Split(strEmail, ";")
    For i = LBound(strEmailAdr) To UBound(strEmailAdr)
        sEmail = LCase(Trim(CStr(strEmailAdr(i))))
        'sEmail = LCase(Trim(sEmail))
        IsValidEmailAddress = False
        If Len(sEmail) < 7 Then '-- Is [email protected] a valid email address?
           sReason = sEmail & " : Too short!"
        ElseIf sEmail Like "*[!0-9a-z@._+-]*" Then
           '-- not sure about these characters: ! $ & ` ' * / \ = ? ^ | # &#37; { } ~
           '   if required, add in to the above string after letter z and before the last hyphen -
           sReason = sEmail & " : Invalid character in email!"
        ElseIf Not sEmail Like "*@*.*" Then
           sReason = sEmail & " : Missing the @ or .!"
        ElseIf sEmail Like "*@*@*" Then
           sReason = sEmail & " : Too many @!"
        ElseIf sEmail Like "[@.]*" Or sEmail Like "*[@.]" _
           Or sEmail Like "*..*" Or Not sEmail Like "?*@?*.*?" Then
           sReason = sEmail & " : Invalid format!"
        Else
           Dim n As Integer
           n = Len(sEmail) - InStrRev(sEmail, ".")
           If n > 3 Then
              sReason = sEmail & " : Suffix too long!"
           ElseIf n < 2 Then
              sReason = sEmail & " : Suffix too short!"
           Else
              sReason = Empty
              IsValidEmailAddress = True
           End If
        End If
    Next i

  Exit Function
IsValidEmailAddress_Err:
  MsgBox "PublicFonctions.IsValidEmailAddress : " & vbCrLf & _
         "Error " & Err.Number & " " & Err.Description
  On Error GoTo 0
End Function

'---------------------------------------------
Sub testmail()
    Dim str As String
    MsgBox PublicFonctions.IsValidEmailAddress("[email protected];[email protected];aezaeaz.com", str)
    MsgBox str
End Sub

[laudeniold]

Wow! Cool code. Super advance... Many thanks to you...