Need to ensure an e-mail address is valid?
This copy-and-paste code snippet checks an address for its length, the @ sign, the period, the characters used, the suffix – and more!
Save your overworked fingers further strain and add this snippet to your code library.
To use it, simply call the IsEMailAddress function, passing in an e-mail address and an optional ‘reason’ string variable. The procedure will return a True if the e-mail address is valid, a False otherwise.
If False is returned, the reason for its failure will be passed back into the optional reason string.
With thanks to Paul Brown for the code base (slightly revised for publication).
Usage
Dim IsValid As Boolean
Dim InvalidReason As String
IsValid = IsEMailAddress("karl@karlmoore.com", _
InvalidReason)
MsgBox "Is the e-mail address valid? - " & IsValid
MsgBox "If invalid, the reason given is: " & InvalidReason
Code
Public Function IsEMailAddress(ByVal sEmail As String, _
Optional ByRef sReason As String) As Boolean
Dim sPreffix As String
Dim sSuffix As String
Dim sMiddle As String
Dim nCharacter As Integer
Dim sBuffer As String
sEmail = Trim(sEmail)
If Len(sEmail) < 8 Then
IsEMailAddress = False
sReason = "Too short"
Exit Function
End If
If InStr(sEmail, "@") = 0 Then
IsEMailAddress = False
sReason = "Missing the @"
Exit Function
End If
If InStr(InStr(sEmail, "@") + 1, sEmail, "@") <> 0 Then
IsEMailAddress = False
sReason = "Too many @"
Exit Function
End If
If InStr(sEmail, ".") = 0 Then
IsEMailAddress = False
sReason = "Missing the period"
Exit Function
End If
If InStr(sEmail, "@") = 1 Or InStr(sEmail, "@") = Len(sEmail) Or _
InStr(sEmail, ".") = 1 Or InStr(sEmail, ".") = Len(sEmail) Then
IsEMailAddress = False
sReason = "Invalid format"
Exit Function
End If
For nCharacter = 1 To Len(sEmail)
sBuffer = Mid$(sEmail, nCharacter, 1)
If Not (LCase(sBuffer) Like "[a-z]" Or sBuffer = "@" Or _
sBuffer = "." Or sBuffer = "-" Or sBuffer = "_" Or _
IsNumeric(sBuffer)) Then: IsEMailAddress = _
False: sReason = "Invalid character": Exit Function
Next nCharacter
nCharacter = 0
On Error Resume Next
sBuffer = Right(sEmail, 4)
If InStr(sBuffer, ".") = 0 Then GoTo TooLong:
If Left(sBuffer, 1) = "." Then sBuffer = Right(sBuffer, 3)
If Left(Right(sBuffer, 3), 1) = "." Then sBuffer = Right(sBuffer, 2)
If Left(Right(sBuffer, 2), 1) = "." Then sBuffer = Right(sBuffer, 1)
If Len(sBuffer) < 2 Then
IsEMailAddress = False
sReason = "Suffix too short"
Exit Function
End If
TooLong:
If Len(sBuffer) > 3 Then
IsEMailAddress = False
sReason = "Suffix too long"
Exit Function
End If
sReason = Empty
IsEMailAddress = True
End Function
