Re: Code to check if a valid e-mail address was entered

From: at (Peter)
Date: 10/15/04 

Date: Fri, 15 Oct 2004 11:00:44 +0100

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:
' string1@string2.string3
' 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

On Wed, 13 Oct 2004 14:17:48 -0400, "LisaB"
<lbagley(ReTHis)@mayatech.com> wrote:

>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. someone@somewhere.com or someoneelse@somewhere.com
>c. Unknown
>d. someone@somewhere.come;someoneelse@somewhere.com
>e. someone@somewhere.com
>f. <blank>
>g. SomeName - someone@somewhere.com
>
>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

Relevant Pages