You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

168 lines
3.9 KiB
Plaintext

function CheckEmailAddr(sCheckEmail)
Dim sEmail, sTld
sEmail = Trim(lcase(sCheckEmail))
'Must have at least two characters bef,e the @
If Instr(2, sEmail, "@") then
'Must be a valid Top Level domain
If ValidateTLD(Mid(sEmail,Instr(1,sEmail , ".") + 1)) then
CheckEmailAddr = True
End If
End If
End function
function ValidateTLD(sTLD)
'Validate the TLD extension to make sure it is a valid.
Select Case lCase(trim(sTLD))
'Test f, American TLD's
'Seperated in case you want only US email Addrs
Case "com" ,"net" ,"org" ,"edu" ,"mil"
ValidateTLD = True
'Add the new Seven
Case "firm" , "st,e" , "web" , "arts" , "rec" , "info" , "nom"
ValidateTLD = true
'Start with the A's
Case "ac" , _
"af" , _
"am" , _
"as" , _
"at" , _
"au" , _
"ar"
ValidateTLD = True
Case "be" , _
"br" , _
"bt" , _
"bo" ' .com.bo com.bo
ValidateTLD = True
Case "ca" , _
"cc" , _
"ch" , _
"cn" , _
"cz" , _
"cl" , _
"cx" , _
"cr"
ValidateTLD = True
Case "de" , _
"dk"
ValidateTLD = True
Case "ec" , _
"eg" , _
"es"
ValidateTLD = True
Case "fo" , _
"fr"
ValidateTLD = True
Case "gf" , _
"gs" , _
"gr"
ValidateTLD = True
Case "hm"
ValidateTLD = True
Case "il" , _
"in" , _
"is" , _
"it" , _
"ie" ' .ie ie
ValidateTLD = True
Case "jp" ' .ac.jp Japan Academic
ValidateTLD = True
Case "kr" ' .ac.kr K,ea Academic
ValidateTLD = True
Case "li" , _
"lt" , _
"lu" , _
"lb" , _
"la"
ValidateTLD = True
Case "mc" , _
"mm" , _
"ms" , _
"mx" , _
"my" , _
"md"
ValidateTLD = True
Case "nl" , _
"no" , _
"nu" , _
"nz" ' .co.nz co.nz
ValidateTLD = True
Case "pl" , _
"pt" , _
"pk" , _
"pe" , _
"ph"
ValidateTLD = True
Case "ro" , _
"ru" , _
"ro" ' .ro ro
ValidateTLD = True
Case "se" , _
"si" , _
"sg" , _
"sk" , _
"st" , _
"sv" , _
"sa"
ValidateTLD = True
Case "tc" ,"tf", "th", "tj", "tm", "to", "tr", "tw", "tv"
ValidateTLD = True
Case "uk" ' .plc.uk UK Plc
ValidateTLD = True
Case "vg" , _
"vu"' .vu vu
ValidateTLD = True
CAse "ws"
ValidateTLD = True
Case "za" ' .web.za South Africa Web
ValidateTLD = True
Case Else
ValidateTLD = false
End Select
End Function