Вы можете использовать приведенную ниже функцию в событии BeforeUpdate текстового поля:
Cancel = Not IsMailAddress(Nz(Me!YourTextbox.Value))
If Cancel = True Then
MessageBox "Please enter a valid e-mail address."
End If
и функция:
Public Function IsEmailAddress( _
ByVal strEmailAddresses As String) _
As Boolean
' Checks if strEMailAddr could represent one or more valid e-mail addresses.
' Does not check validity of domain names.
'
' 2003-06-22. Cactus Data ApS, CPH
' 2018-12-01. Expanded to allow for and validate multiple addresses.
' Allowed characters.
Const cstrValidChars As String = "@_-.0123456789abcdefghijklmnopqrstuvwxyz"
Const cstrDot As String = "."
Const cstrAt As String = "@"
' Minimum length of an e-mail address (a@a.ca).
Const cintAddressLenMin As Integer = 6
' Address separator.
Const cstrSeparator As String = ";"
Dim avarAddresses As Variant
Dim Index As Integer
Dim strEmailAddr As String
Dim strValidChars As String
Dim booFailed As Boolean
Dim intPos As Integer
Dim intI As Integer
avarAddresses = Split(strEmailAddresses, cstrSeparator)
For Index = LBound(avarAddresses) To UBound(avarAddresses)
strEmailAddr = avarAddresses(Index)
' Strip a display name.
CleanEmailAddress strEmailAddr
' Convert to lowercase.
strEmailAddr = LCase(strEmailAddr)
' Check that strEMailAddr contains allowed characters only.
For intI = 1 To Len(strEmailAddr)
If InStr(cstrValidChars, Mid(strEmailAddr, intI, 1)) = 0 Then
booFailed = True
End If
Next
If booFailed = False Then
' Check that the first character is not cstrAt.
booFailed = Left(strEmailAddr, 1) = cstrAt
If booFailed = False Then
' Check that the first character is not a cstrDot.
booFailed = Left(strEmailAddr, 1) = cstrDot
If booFailed = False Then
' Check that length of strEMailAddr exceeds
' minimum length of an e-mail address.
intPos = Len(strEmailAddr)
booFailed = (intPos < cintAddressLenMin)
If booFailed = False Then
' Check that none of the last two characters of strEMailAddr is a dot.
booFailed = (InStr(intPos - 1, strEmailAddr, cstrDot) > 0)
If booFailed = False Then
' Check that strEMailAddr does contain a cstrAt.
intPos = InStr(strEmailAddr, cstrAt)
booFailed = (intPos = 0)
If booFailed = False Then
' Check that strEMailAddr does contain one cstrAt only.
booFailed = (InStr(intPos + 1, strEmailAddr, cstrAt) > 0)
If booFailed = False Then
' Check that the character leading cstrAt is not cstrDot.
booFailed = (Mid(strEmailAddr, intPos - 1, 1) = cstrDot)
If booFailed = False Then
' Check that the character following cstrAt is not cstrDot.
booFailed = (Mid(strEmailAddr, intPos + 1, 1) = cstrDot)
If booFailed = False Then
' Check that strEMailAddr contains at least one cstrDot
' following the sign after cstrAt.
booFailed = Not (InStr(intPos, strEmailAddr, cstrDot) > 1)
End If
End If
End If
End If
End If
End If
End If
End If
End If
If booFailed = True Then
Exit For
End If
Next
IsEmailAddress = Not booFailed
End Function