MS Access 表的电子邮件地址验证

Posted 2023-05-06

【中文标题】MS Access 表的电子邮件地址验证

【英文标题】：Email address validation for MS Access table

【发布时间】：2018-04-30 12:24:40

【问题描述】：

我的表在 Access 表的“验证规则”部分中进行了以下验证，以使我输入的大多数电子邮件地址保持干净：

喜欢“?@?.??”而不喜欢“[!a-z@=.^_$%!#&'`|?~/-]" 和 .

但是，它仍然允许像 [e-mail].u 这样的东西

我找到了这个 javascript 链接。它比我的做得好得多，并且会过滤掉上面提到的那种电子邮件地址。 How to validate an email address in JavaScript

MS Access 的外观如何？函数或验证规则很好，只是想知道它是否可能。

【问题讨论】：

另一个潜入的邮件也是 bla@web.d 之类的电子邮件，而不是 [e-mail]。

【参考方案1】：

RegExp 是验证电子邮件的最佳方式。

这是一个 VBA 函数，在您链接的答案中使用正则表达式

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

您必须添加对您项目的引用：Microsoft VBScript Regular Expressions X.X

当你想验证时，调用函数使用

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

它将返回 TRUE 或 FALSE（在这种情况下为 false）

【讨论】：

对于那些至少看 Microsoft VBScript Regular Expressions 5.5 Ms Access 2013 的人

【参考方案2】：

嘿，Thomas 非常感谢你的功能真的很有帮助。对于其他所有人，我刚刚发布了我如何实现您的功能。

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

【讨论】：

SQL中的where语句只是为了减少带回的记录数