Проверка адреса электронной почты для таблицы MS Access

Question

Моя таблица имеет следующую проверку в разделе «Правило проверки» таблицы Access, в которой содержится большинство адресов электронной почты, которые я ввожу, чистыми:

Мне нравится "?@?.??" И не нравится " [! Az@=.^_$%!#&'`‹||? ~ / -]"и.

Тем не менее, он по-прежнему впускает такие вещи, как Bla.Bla@testing.co.u

Я нашел эту ссылку для JavaScript. Он работает намного лучше, чем мой, и отфильтровывает адреса электронной почты, упомянутые выше. Как проверить адрес электронной почты в JavaScript

Как бы это выглядело для MS Access? Функция или правило валидации хорошо, просто интересно узнать, возможно ли это.

Answer 1

Привет, Томас, большое спасибо, твоя функция действительно помогла. Для всех остальных я только что опубликовал, как я реализовал вашу функцию.

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

Answer 2

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

Вы должны добавить ссылку на свой проект: Microsoft VBScript Regular Expressions X.X

Если вы хотите подтвердить, вызовите функцию, используя

Email_Validation("Bla.Bla@testing.co.u")

вернет TRUE или FALSE (в этом случае false)