Email "Trap Formatting"

  • Thread starter Thread starter Bob Barnes
  • Start date Start date
B

Bob Barnes

Any code to "ensure" text entered is likely to be a correctly formatted
email address....IE..only one @ (use an "InStr"), and Instr to look for
things like ".com"...".org"...".edu".

Or is it best to let an invalid Email address (might be formatted correctly,
but not valid) fail on Sending it???

TIA - Bob
 
Thank you Beetle...Bob

Beetle said:
Use a validation rule in your table like;

Is Null OR ((Like "*?@?*.?*") AND (Not Like "*[ ,;]*"))

For more on validation rules see;

http://allenbrowne.com/ValidationRule.html

--
_________

Sean Bailey


Bob Barnes said:
Any code to "ensure" text entered is likely to be a correctly formatted
email address....IE..only one @ (use an "InStr"), and Instr to look for
things like ".com"...".org"...".edu".

Or is it best to let an invalid Email address (might be formatted correctly,
but not valid) fail on Sending it???

TIA - Bob
Click to expand...
Click to expand...
 
Bob Barnes said:
Any code to "ensure" text entered is likely to be a correctly formatted
email address....IE..only one @ (use an "InStr"), and Instr to look for
things like ".com"...".org"...".edu".
Click to expand...

One of my email addresses is tony @ granite . ab . ca. So how does
that figure in validating? One little know TLD that's valid is
..int. Those organizations are created by the UN and there are only
19 of those. Or something like that.

Basically about all you can assume is something to the left of the @
sign and something to the right of the @ sign that has a period in it
somewhere.

Tony
 
What about this Function! ....Regards Bob

Public Function IsValidEmail(emailAddress As String) As Boolean
'Check if e-mail address is a valid address
' Requires "tblCountryCodes", "tblDomain Suffix"



Dim Pos As Long, iveLth As Integer, I As Integer, isOkMail As Boolean, _
iveStr As String, chrOK(66) As String, chrFound As Boolean, iveIdStr As
String, _
iveDomStr As String, idTmp As Variant, iveSfx As String, strChrDesc

Dim ivePmt As String, iveBtns As Integer, iveTitle As String, iveResp As
Integer
iveTitle = "e-Mail address verification"
iveBtns = vbExclamation

isOkMail = True
iveStr = Trim(emailAddress)
iveLth = Len(iveStr)
'Checking for illegal characters

'Permitted 45-46 (-.), 48-57 (digits); 64 @, 65-90 (Ucase alpha); 97-122
(Lcase alpha)
' 95 (_)

chrOK(1) = Chr(45)
chrOK(2) = Chr(46)
For I = 48 To 57
chrOK(I - 45) = Chr(I)
Next I

For I = 64 To 90
chrOK(I - 51) = Chr(I)
Next I
chrOK(40) = Chr(95)
For I = 97 To 122
chrOK(I - 56) = Chr(I)
Next I

For Pos = 1 To iveLth
chrFound = False
For I = 1 To 66
If Mid(iveStr, Pos, 1) = chrOK(I) Then
chrFound = True
Exit For
End If
Next I
If Not chrFound Then

strChrDesc = Mid(iveStr, Pos, 1)
Select Case strChrDesc
Case " "
strChrDesc = "(space)"
Case Chr(34)
strChrDesc = "(qoutation mark)"
Case "'"
strChrDesc = "(Apostrophe)"
Case Else
strChrDesc = "'" & strChrDesc & "'"
End Select
IsValidEmail = False

MsgBox "Ilegal character " & strChrDesc & " Found in Position "
& Pos _
& Chr(13) & "Adresss: " & iveStr & " Character: " & strChrDesc
_
& " = Chr(" & Asc(Mid(iveStr, Pos, 1)) & ") ", iveBtns,
iveTitle



Exit Function
End If

Next Pos

' Test for @
Pos = InStr(1, iveStr, "@")

If Pos = 1 Or Pos > iveLth - 4 Then
IsValidEmail = False
MsgBox "@ charcter is in wrong position", iveBtns, iveTitle
Exit Function
ElseIf Pos = 0 Or IsNull(Pos) Then
IsValidEmail = False
MsgBox "No @ character found", iveBtns, iveTitle
Exit Function

End If

iveIdStr = Left(iveStr, Pos - 1)
iveDomStr = Right(iveStr, Len(iveStr) - Pos)

If Len(iveDomStr) > 67 Then
MsgBox "Domain name is too long - maximum is 67 characters ",
iveBtns, iveTitle
IsValidEmail = False
Exit Function
End If


Pos = InStr(1, iveDomStr, "@")

If Pos > 0 Then
IsValidEmail = False
MsgBox "@ character found more then one time", iveBtns, iveTitle
Exit Function

End If

'checking for last dot

Pos = InStrRev(iveDomStr, ".")
'If Pos < Len(iveDomStr) - 3 Or Pos > Len(iveDomStr) - 2 Then
If Pos < Len(iveDomStr) - 4 Or Pos > Len(iveDomStr) - 2 Then

IsValidEmail = False
MsgBox "Last dot (.) is in wrong position or missing", iveBtns,
iveTitle
Exit Function

End If

'check for 2 consec dots

Pos = InStr(1, iveStr, "..")
If Pos > 0 Then
IsValidEmail = False
MsgBox "2 consecutive dots (..) found", iveBtns, iveTitle
Exit Function

End If

'Test for valid domain suffix

Pos = InStrRev(iveDomStr, ".")
If Pos = Len(iveDomStr) - 2 Then
iveSfx = Right(iveDomStr, 2)
idTmp = DLookup("[Country_ID]", "tblCountryCodes", "[Country
Code]='" & iveSfx & "'")
If IsNull(idTmp) Then
iveBtns = vbOKCancel + vbQuestion
ivePmt = "Domain suffix '." & iveSfx & "' not found " &
Chr(13) & Chr(13) _
& "Use '" & iveSfx & "' anyway? "
iveResp = MsgBox(ivePmt, iveBtns, iveTitle)
If iveResp = vbCancel Then
IsValidEmail = False
Exit Function
End If
End If

Else
iveSfx = Right(iveDomStr, Len(iveDomStr) - Pos)
idTmp = DLookup("[DomSuffix_ID]", "tblDomain Suffix", "[Suffix]='" &
iveSfx & "'")
If IsNull(idTmp) Then
iveBtns = vbExclamation
ivePmt = "Invalid domain suffix '." & iveSfx & "'"
MsgBox ivePmt, iveBtns, iveTitle
IsValidEmail = False
Exit Function

End If
End If

IsValidEmail = True


End Function
 
Bob Vance said:
What about this Function! ....Regards Bob
Click to expand...

No idea as I'm not going to go through that code line by line
understanding what it does.

I suspect any validating of TLDs is going to be overshadowed by the
reality that typo's happen all the time to the left and to the right
of the @ sign.

Tony
 
Back
Top