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 a@b.com 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. :bigyello:

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 a@b.com 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



:wave: 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:
peter.smith@abc.com.au
peter.van.smith@abc.com.au

[golgot666]

many thanks :wave: 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 a@b.com a valid email address?
sReason = sEmail & " : 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 = 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("peter.van.smith@abc.com.au;olo@dololo.com;aezaeaz.com", str)
MsgBox str
End Sub