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