Email address validation for MS Access table

问题:

My table has the following validation in the "Validation Rule" Section of an Access table that keeps most the email addresses I enter clean:

Like "?@?.??" And Not Like "[!a-z@=.^_$%!#&'`{|}?~/-]" and .

However, it still lets in stuff like [e-mail].u

I found this link for JavaScript. It does a much better job than mine and would filter out the kind of email addresses mentioned above. How to validate an email address in JavaScript

How would it look for MS Access? Function or Validation rule are fine just interested to know if it is possible.

回答1:

RegExp is the best way to validate an email.

Here's a VBA function that does it, using the RegExp in the answer that you linked

Public Function Email_Validation(ByVal strEmail As String) As Boolean


    Const strRexExp As String = "^(([^<>()\[\]\\.,;:\s@""]+(\.[^<>()\[\]\\.,;:\s@""]+)*)|("".+""))@((\[[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\])|(([a-zA-Z\-0-9]+\.)+[a-zA-Z]{2,}))$"

    Dim objRG As New RegExp
    Dim IsValid As Boolean

    On Error GoTo Err_Handler

    strEmail = Trim(strEmail)

    objRG.IgnoreCase = True
    objRG.Global = True
    objRG.Pattern = strRexExp

    IsValid = objRG.Test(strEmail)


Exit_Function:
    Email_Validation = IsValid
    Exit Function

Err_Handler:
    IsValid = False
    MsgBox "Email_Validation Error: " & Err.Number & vbCrLf & vbCrLf & Err.Description
    Resume Exit_Function
End Function

You have to add a reference to your project : Microsoft VBScript Regular Expressions X.X

When you want to validate, call the function using

Email_Validation("[e-mail].u")

it will return TRUE or FALSE (false in that case)

回答2:

Hey Thomas thanks alot your function really helped. For everyone else ive just posted how i implemented your function.

Public Function Email_Validation(ByVal strEmail As String) As Boolean


    Const strRexExp As String = "^(([^<>()\[\]\\.,;:\s@""]+(\.[^<>()\[\]\\.,;:\s@""]+)*)|("".+""))@((\[[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\])|(([a-zA-Z\-0-9]+\.)+[a-zA-Z]{2,}))$"

    Dim objRG As New RegExp
    Dim IsValid As Boolean

    On Error GoTo Err_Handler

    strEmail = Trim(strEmail)

    objRG.IgnoreCase = True
    objRG.Global = True
    objRG.Pattern = strRexExp

    IsValid = objRG.Test(strEmail)


Exit_Function:
    Email_Validation = IsValid
    Exit Function

Err_Handler:
    IsValid = False
    MsgBox "Email_Validation Error: " & Err.Number & vbCrLf & vbCrLf & Err.Description
    Resume Exit_Function
End Function

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("Select * FROM Emails WHERE DateAdded =#" & Date & "#;")
Dim Email As String

'Check to see if the table has any rows
If Not (rs.EOF And rs.BOF) Then
    rs.MoveFirst 'Unnecessary in this case, but still a good habit
    Do Until rs.EOF = True
        'Perform an edit
       If Email_Validation(rs!Emails) = True Then
        rs.MoveNext
       Else
        rs.Delete
       End If
    rs.MoveNext
    Loop
Else
MsgBox "There are no records in the recordset."
End If

rs.Close 'Close the recordset
Set rs = Nothing 'Clean up