Validation MS Access表的电子邮件地址验证
“我的表”在Access表的“验证规则”部分中具有以下验证,该表保持了我输入的大多数电子邮件地址的干净性: 比如?@?。??而不是像[!a-z@.^$%!&'{}?~/-]和 然而,它仍然允许像Bla这样的东西进入。Bla@testing.co.u 我找到了这个JavaScript链接。它比我的要好得多,可以过滤掉上面提到的那种电子邮件地址Validation MS Access表的电子邮件地址验证,validation,ms-access,vba,ms-access-2010,Validation,Ms Access,Vba,Ms Access 2010,“我的表”在Access表的“验证规则”部分中具有以下验证,该表保持了我输入的大多数电子邮件地址的干净性: 比如?@?。??而不是像[!a-z@.^$%!&'{}?~/-]和 然而,它仍然允许像Bla这样的东西进入。Bla@testing.co.u 我找到了这个JavaScript链接。它比我的要好得多,可以过滤掉上面提到的那种电子邮件地址 如何查找MS Access?函数或验证规则很好,只是想知道它是否可行。RegExp是验证电子邮件的最佳方法 下面是一个VBA函数,它使用您链接的答案中的Re
如何查找MS Access?函数或验证规则很好,只是想知道它是否可行。RegExp是验证电子邮件的最佳方法 下面是一个VBA函数,它使用您链接的答案中的RegExp来执行此操作
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
在这种情况下,它将返回TRUE或FALSE FALSE嘿,托马斯,谢谢你的函数对我的帮助。对于其他人,我刚刚发布了我是如何实现你的功能的
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
另一个悄悄进来的邮件也像bla@web.d而不是bla@web.de.TheSQL中的where语句只是为了减少为查看其Microsoft VBScript正则表达式5.5 Ms Access 2013的用户带来的记录数
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