I generally validate email addresses in Filemaker and find this a much quick and easier solution. But I get asked a fair bit how would you be able to validate an email address in Excel.
There are a couple of ways to do this, a quick and simple approach is to simply check if the cell is a hyperlink (i.e. Excel has done a check as it was entered) and then check for “@”.
Sub IsValidEMailAddress_Simple()
Range(“A1”).Select
If ActiveCell.Hyperlinks(1).Type = msoHyperlinkRange Then
intChar = InStr(1, ActiveCell.Hyperlinks(1).Address, “@”)
MsgBox ActiveCell.Value & ” not hyperlink”
‘Was the ‘@’ found?
If intChar > 0 Then
‘Does hyperlink contain ‘@’?
MsgBox ActiveCell.Value & ” missing @”
End If
End If
End Sub
This generally isn’t ideal and so for a much more comprehensive check this code (an Excel VB function) will fully validate a referenced cell with an email address in as a true or false (boolean). There is a text file download at the end incase you get formatting issues with copy and paste.
Public Function IsValidEMailAddress( _
ByVal EMailAddress As String, _
Optional ByVal Strict As Boolean = False _
) As Boolean‘ Return True if the email address referenced is valid, False otherwise.
Const Domain_Extensions = “|aero|biz|com|coop|edu|gov|info|int|mil|museum|name|net|org|pro|travel|”
Const Country_Extensions = “|ac|ad|ae|af|ag|ai|al|am|an|ao|aq|ar|as|at|au|aw|ax|az|ba|bb|bd|be|bf|bg|bh|bi|bj|bm|bn|bo|br|bs|bt|bv|bw|by|bz|ca|cc|cd|cf|cg|ch|ci|ck|cl|cm|cn|co|cr|cs|cu|cv|cx|cy|cz|de|dj|dk|dm|do|dz|ec|ee|
eg|eh|er|es|et|eu|fi|fj|fk|fm|fo|fr|ga|gb|gd|ge|gf|gg|gh|gi|gl|gm|gn|gp|gq|gr|gs|gt|gu|gw|gy|hk|
hm|hn|hr|ht|hu|id|ie|il|im|in|io|iq|ir|is|it|je|jm|jo|jp|ke|kg|kh|ki|km|kn|kp|kr|kw|ky|kz|la|lb|lc|li|
lk|lr|ls|lt|lu|lv|ly|ma|mc|md|mg|mh|mk|ml|mm|mn|mo|mp|mq|mr|ms|mt|mu|mv|mw|mx|my|mz|
na|nc|ne|nf|ng|ni|nl|no|np|nr|nu|nz|om|pa|pe|pf|pg|ph|pk|pl|pm|pn|pr|ps|pt|pw|py|qa|re|ro|ru|rw|
sa|sb|sc|sd|se|sg|sh|si|sj|sk|sl|sm|sn|so|sr|st|sv|sy|sz|tc|td|tf|tg|th|tj|tk|tl|tm|tn|to|tp|tr|tt|tv|tw|
tz|ua|ug|uk|um|us|uy|uz|va|vc|ve|vg|vi|vn|vu|wf|ws|ye|yt|yu|za|zm|zw|”
Const Invalid_Chars = “/’\””;:?!()[]{}^| ”
Const Invalid_Chars_Strict = “/’\””;:?!()[]{}^|$&*+=`<>,% ”
Const Invalid_Domains = “|aso|dnso|icann|internic|pso|afrinic|apnic|arin|example|gtld-servers|iab|iana|iana-servers|iesg|ietf|irtf|istf|lacnic|latnic|rfc -editor|ripe|root-servers|nic|whois|www|arpa|”Dim Index As Long
Dim Extension As String
Dim Domain As String
Dim Position1 As Long
Dim Position2 As LongIf Len(EMailAddress) = 0 Then
IsValidEMailAddress = True
Exit Function
End IfEMailAddress = LCase(EMailAddress)
‘ Check for invalid characters
If Strict Then
For Index = 1 To Len(EMailAddress)
If InStr(Invalid_Chars_Strict, Mid(EMailAddress, Index, 1)) > 0 Then
Exit Function
End If
Next Index
Else
For Index = 1 To Len(EMailAddress)
If InStr(Invalid_Chars, Mid(EMailAddress, Index, 1)) > 0 Then
Exit Function
End If
Next Index
End If‘ Check for valid extension
Index = InStrRev(EMailAddress, “.”)
If Index = 0 Then Exit Function
Extension = Mid(EMailAddress, Index + 1)
If InStr(Domain_Extensions, “|” & Extension & “|”) = 0 And InStr(Country_Extensions, “|” & Extension & “|”) = 0 Then Exit Function‘ Check for consecutive dots
If InStr(EMailAddress, “..”) > 0 Then Exit Function‘ Check for more than one ampersand
If InStr(Replace(EMailAddress, “@”, ” “, Count:=1), “@”) > 0 Then Exit Function‘ Check for text prior to the ampersand
Index = InStr(EMailAddress, “@”)
If Not Index > 1 Then Exit Function‘ Check for a period after the ampersand
If Mid(EMailAddress, Index + 1, 1) = “.” Then Exit FunctionPosition1 = InStr(EMailAddress, “@”) + 1
Position2 = InStr(Position1, EMailAddress, “.”) – 1
Domain = Mid(EMailAddress, Position1, Position2 – Position1 + 1)If Strict Then
‘ Check for single character domain
If Len(Domain) = 1 Then Exit Function
‘ Check for an invalid domain
If InStr(Invalid_Domains, “|” & Domain & “|”) > 0 Then Exit Function
If InStr(Domain_Extensions, “|” & Domain & “|”) > 0 Then Exit Function
End If‘ Check for dash in the first, last, third, or fourth position of the domain
If Left(Domain, 1) = “-” Then Exit Function
If Right(Domain, 1) = “-” Then Exit Function
If Len(Domain) > 2 Then
If Mid(Domain, 3, 1) = “-” Then Exit Function
If Len(Domain) > 3 Then
If Mid(Domain, 4, 1) = “-” Then Exit Function
End If
End If‘ Check for more then 67 characters in the domain and extension
If Len(Domain) + Len(Extension) > 67 Then Exit FunctionIsValidEMailAddress = True
End Function
Great email validation script! However, it detects that email domains like ubc-huntsville.org are invalid. However, I can go visit their website just fine, which means it is a valid domain name. I see the code is trying to check for dashes in the first, last, third, and fourth positions in the domain name. But, clearly it’s missed the mark on the above example.
There is a minor mistake in your code that Greg points out above.
The requirement should be that there are not two consecutive dashes in the third AND fourth position. (www.rnids.rs/data/DOKUMENTI/Opsti%20akti/list0029_en.pdf)
Your code looks for dashes in the third OR forth position and eliminates some proper addresses. Here is a fix:
Dim DashCount as Integer
‘ Check for dash in the first or last position of the domain
If Left(Domain, 1) = “-” Then Exit Function
If Right(Domain, 1) = “-” Then Exit Function
‘ Check for dash in the 3rd & 4th positions of the domain
DashCount = 0
If Len(Domain) > 2 Then
If Mid(Domain, 3, 1) = “-” Then DashCount = 1
If Len(Domain) > 3 Then
If Mid(Domain, 4, 1) = “-” Then DashCount = DashCount + 1
End If
If DashCount = 2 Then Exit Function
End If
Pingback: Mailto Links in VBA - JP Software Technologies