You first need to Normalise the data, for all sorts of reasons. You
can't do anything useful with a field whose contents are so
disorganised.
The first step, therefore, is to strip out everything that isn't
(attempting to be) a valid email address. If it is common to have more
than one recorded email address, you probable need a separate table
for email addresses with a many to one relationship to the table you
are currently concerned with.
Once you have a Field containing only things that are supposed to be
email addresses, the following Function will test them for validity.
It was designed to work reliably, not to be particularly fast! Also,
watch out for unintended line wraps.
Private Declare Function IsCharAlphaNumeric Lib "USER32" Alias
"IsCharAlphaNumericA" (ByVal cChar As Byte) As Long
Private Declare Function IsCharAlpha Lib "USER32" Alias "IsCharAlphaA"
(ByVal cChar As Byte) As Long
Function Valid_Email(E_Address As String) As Boolean
' The Function assumes that a valid email address will be of the form:
' (e-mail address removed)3
' where string1, string2, and string3 may contain letters, numbers,
hyphens,
' underscores, and dots, but no other non-alphanumeric characters or
spaces
' Note that the part after the @ sign must contain at least one dot,
with
' at least one other character following it, and no string may
' contain consecutive or terminal dots
' String1 may also (surprisingly) contain apostrophes - PRF 13/7/2002
' Valid states are as follows:
' 0 On entry
' 1 character in string1 found
' 2 dot found
' 3 @ sign found
' 4 character in string2 found
' 5 dot found
' 6 character in string3 found
' 7 valid email address recognised
' 9 invalid email address recognised
Dim TString As String
Dim State As Integer
Dim tChar As Integer
Dim isalphanum As Boolean, isdot As Boolean, isat As Boolean
Dim isapostrophe As Boolean
Valid_Email = False
TString = RTrim$(LTrim$(E_Address))
If Len(TString) = 0 Then Exit Function
State = 0
Do While (State < 7)
If Len(TString) = 0 Then
If State = 6 Then
State = 7
Exit Do
Else
State = 9
End If
Else
tChar = Asc(TString)
isdot = False
isat = False
isalphanum = False
isapostrophe = False
If IsCharAlphaNumeric(tChar) Then
isalphanum = True
ElseIf tChar = Asc("_") Or tChar = Asc("-") Then
isalphanum = True
ElseIf tChar = Asc(".") Then
isdot = True
ElseIf tChar = Asc("@") Then
isat = True
ElseIf tChar = Asc("'") Then
isapostrophe = True
Else
State = 9
End If
End If
Select Case State
Case 0 ' examining first character
If isalphanum Then
State = 1
Else
State = 9
End If
Case 1 ' last character was alphanumeric (string1)
If isdot Then
State = 2
ElseIf isat Then
State = 3
End If
Case 2 ' last character was a dot (within string1)
If isalphanum Then
State = 1
Else
State = 9
End If
Case 3 ' last character was an @ sign
If isalphanum Then
State = 4
Else
State = 9
End If
Case 4 ' last character was alphanumeric (string2)
If isdot Then
State = 5
ElseIf isat Or isapostrophe Then
State = 9
End If
Case 5 ' last character was dot (between string2 and string3)
If isalphanum Then
State = 6
Else
State = 9
End If
Case 6 ' last character was alphanumeric (string3)
If isdot Then
State = 5
ElseIf isat Or isapostrophe Then
State = 9
End If
Case Else
State = 9
End Select
TString = Mid$(TString, 2)
Loop
If State = 7 Then Valid_Email = True
End Function
Does anyone know the code or know where I can find code to check a field to
make sure the e-mail address is valid?
I have a table that holds contact information.
One field holds the e-mail address.
This data was imported from another database and some of the entries in this
field are as follows:
a. no current email address
b. (e-mail address removed) or (e-mail address removed)
c. Unknown
d. (e-mail address removed);
[email protected]
e. (e-mail address removed)
f. <blank>
g. SomeName - (e-mail address removed)
I need code to loop through this table and return all the ones that are not
valid (not accepted by outlook as a valid e-mail address)
also
is there code to prevent a user from entering an invalid e-mail address into
a field on a form? (Access 2000)
Thank You
Please respond to the Newsgroup, so that others may benefit from the exchange.
Peter R. Fletcher
