By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,509 Members | 2,201 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,509 IT Pros & Developers. It's quick & easy.

EMail Address Validation

P: n/a
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
Aug 13 '08 #1
Share this Question
Share on Google+
4 Replies


P: n/a
rkc
On Aug 13, 5:16 pm, JvC <johnv...@earthlink.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.
Aug 13 '08 #2

P: n/a
JvC
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...@earthlink.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.

Aug 13 '08 #3

P: n/a
2 Functions

Private Sub MemEMail_BeforeUpdate(Cancel As Integer)

Dim Reason As String

If IsNull(MemSurName) Or IsNull(MemFirstName) 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("ka**@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(sEmail, 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(sEmail, "@") + 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(sBuffer)) 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(sBuffer, 3), 1) = "." Then sBuffer = Right(sBuffer, 2)
If Left(Right(sBuffer, 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" <jo******@earthlink.netwrote in message
news:xB*******************@newsfe07.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...@earthlink.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.


Aug 14 '08 #4

P: n/a
JvC
Very nice, Phil! Thanks!

Phil Stanton formulated the question :
2 Functions

Private Sub MemEMail_BeforeUpdate(Cancel As Integer)

Dim Reason As String

If IsNull(MemSurName) Or IsNull(MemFirstName) 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("ka**@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(sEmail, 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(sEmail, "@") + 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(sBuffer)) 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(sBuffer, 3), 1) = "." Then sBuffer = Right(sBuffer, 2)
If Left(Right(sBuffer, 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" <jo******@earthlink.netwrote in message
news:xB*******************@newsfe07.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...@earthlink.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.


Aug 14 '08 #5

This discussion thread is closed

Replies have been disabled for this discussion.