EMail Address Validation

[JvC]

Does anyone have a good routine for EMail address validation? The one
that I use is fairly primitive, and I need to beef it up. I have
downloaded several from the web, and they all get screwed up by one
thing or another, and tell me valid addresses are invalid.

Thanks!

John

[rkc]

Re: EMail Address Validation

On Aug 13, 5:16 pm, JvC <johnv...@earth link.netwrote:

Does anyone have a good routine for EMail address validation? The one
that I use is fairly primitive, and I need to beef it up. I have
downloaded several from the web, and they all get screwed up by one
thing or another, and tell me valid addresses are invalid.
>

Validate to what extent? That it is well formed or that it actually
exists?
Google for a regular expression if well formed is all you're after.

[JvC]

Re: EMail Address Validation

Just if it's well formed, and your suggestion has done the trick!

rkc presented the following explanation :

On Aug 13, 5:16 pm, JvC <johnv...@earth link.netwrote:

>Does anyone have a good routine for EMail address validation? The one
>that I use is fairly primitive, and I need to beef it up. I have
>downloaded several from the web, and they all get screwed up by one
>thing or another, and tell me valid addresses are invalid.
>>

>
Validate to what extent? That it is well formed or that it actually
exists?
Google for a regular expression if well formed is all you're after.

[Phil Stanton]

Re: EMail Address Validation

2 Functions

Private Sub MemEMail_Before Update(Cancel As Integer)

Dim Reason As String

If IsNull(MemSurNa me) Or IsNull(MemFirst Name) Then
MsgBox "Email can not be altered until you have entered a Surname
and First name", vbInformation
Cancel = True
End If

If Nz(MemEMail) "" Then
If IsEMailAddress( MemEMail, Reason) = False Then
MsgBox "Invalid mail address, because: " & Reason
Cancel = True
Exit Sub
End If
End If

End Sub

Public Function IsEMailAddress( ByVal sEmail As String, _
Optional ByRef sReason As String) As Boolean

'If False is returned, the reason for its failure will be passed back
into the optional reason string.
'IsValid = IsEMailAddress( "karl@karlmoore .com", InvalidReason)
'MsgBox "Invalid mail address, the reason given is: " & InvalidReason

Dim IsValid As Boolean
Dim InvalidReason As String
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
sReason = "Too short"
Exit Function
End If

If LCase(Right(sEm ail, 1)) Like "[a-z]" Then
GoTo CheckAt
End If
sReason = "Illegal character at end" ' Check for '.' etc at end
Exit Function

CheckAt:
If InStr(sEmail, "@") = 0 Then
sReason = "Missing the @"
Exit Function
End If

If InStr(InStr(sEm ail, "@") + 1, sEmail, "@") <0 Then
sReason = "Too many @"
Exit Function
End If

If InStr(sEmail, ".") = 0 Then
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
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(sBuff er)) Then
sReason = "Invalid character"
Exit Function
End If
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(sBuf fer, 3), 1) = "." Then sBuffer = Right(sBuffer, 2)
If Left(Right(sBuf fer, 2), 1) = "." Then sBuffer = Right(sBuffer, 1)

If Len(sBuffer) < 2 Then
sReason = "Suffix too short"
Exit Function
End If

TooLong:
If Len(sBuffer) 3 Then
sReason = "Suffix too long"
Exit Function
End If

sReason = Empty ' Dropped through to here, so email
address OK
IsEMailAddress = True

End Function
"JvC" <johnvonc@earth link.netwrote in message
news:xBJok.2372 7$1N1.19203@new sfe07.iad...

Just if it's well formed, and your suggestion has done the trick!
>
rkc presented the following explanation :

>On Aug 13, 5:16 pm, JvC <johnv...@earth link.netwrote:

>>Does anyone have a good routine for EMail address validation? The one
>>that I use is fairly primitive, and I need to beef it up. I have
>>downloaded several from the web, and they all get screwed up by one
>>thing or another, and tell me valid addresses are invalid.
>>>

>>
>Validate to what extent? That it is well formed or that it actually
>exists?
>Google for a regular expression if well formed is all you're after.

>
>

[JvC]

Re: EMail Address Validation

Very nice, Phil! Thanks!

Phil Stanton formulated the question :

2 Functions
>
Private Sub MemEMail_Before Update(Cancel As Integer)
>
Dim Reason As String
>
If IsNull(MemSurNa me) Or IsNull(MemFirst Name) Then
MsgBox "Email can not be altered until you have entered a Surname and
First name", vbInformation
Cancel = True
End If
>
If Nz(MemEMail) "" Then
If IsEMailAddress( MemEMail, Reason) = False Then
MsgBox "Invalid mail address, because: " & Reason
Cancel = True
Exit Sub
End If
End If
>
End Sub
>
Public Function IsEMailAddress( ByVal sEmail As String, _
Optional ByRef sReason As String) As Boolean
>
'If False is returned, the reason for its failure will be passed back
into the optional reason string.
'IsValid = IsEMailAddress( "karl@karlmoore .com", InvalidReason)
'MsgBox "Invalid mail address, the reason given is: " & InvalidReason
>
Dim IsValid As Boolean
Dim InvalidReason As String
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
sReason = "Too short"
Exit Function
End If
>
If LCase(Right(sEm ail, 1)) Like "[a-z]" Then
GoTo CheckAt
End If
sReason = "Illegal character at end" ' Check for '.' etc at end
Exit Function
>
CheckAt:
If InStr(sEmail, "@") = 0 Then
sReason = "Missing the @"
Exit Function
End If
>
If InStr(InStr(sEm ail, "@") + 1, sEmail, "@") <0 Then
sReason = "Too many @"
Exit Function
End If
>
If InStr(sEmail, ".") = 0 Then
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
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(sBuff er)) Then
sReason = "Invalid character"
Exit Function
End If
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(sBuf fer, 3), 1) = "." Then sBuffer = Right(sBuffer, 2)
If Left(Right(sBuf fer, 2), 1) = "." Then sBuffer = Right(sBuffer, 1)
>
If Len(sBuffer) < 2 Then
sReason = "Suffix too short"
Exit Function
End If
>
TooLong:
If Len(sBuffer) 3 Then
sReason = "Suffix too long"
Exit Function
End If
>
sReason = Empty ' Dropped through to here, so email
address OK
IsEMailAddress = True
>
End Function
"JvC" <johnvonc@earth link.netwrote in message
news:xBJok.2372 7$1N1.19203@new sfe07.iad...

>Just if it's well formed, and your suggestion has done the trick!
>>
>rkc presented the following explanation :

>>On Aug 13, 5:16 pm, JvC <johnv...@earth link.netwrote:
>>>Does anyone have a good routine for EMail address validation? The one
>>>that I use is fairly primitive, and I need to beef it up. I have
>>>downloaded several from the web, and they all get screwed up by one
>>>thing or another, and tell me valid addresses are invalid.
>>>>
>>>
>>Validate to what extent? That it is well formed or that it actually
>>exists?
>>Google for a regular expression if well formed is all you're after.

>>
>>