invoermasker validatieregel e-mail

[Plotinus]

Ik probeer een validatieregel op te stellen voor e-mailadres en heb hiervoor het volgende gevonden:

Is Null OR ( ( Like " ? . ? * @ * * " ) AND ( Not Like " * [ , , ] * " ) )

(zie site http://www.nldit.com/software/database-software/201309/115325.html)

Het blijkt echter niet te werken en komt dus steeds terug met een foutmelding bij een e-mail als dit 'aaa.bbb@ccc.be´
Iemand een idee waar dit aan kan liggen?

 

[OctaFish]

Ik zou eerder aan een Regular Expression denken dan aan zo'n constructie.

 

[JohanRVT]

Probeer eens deze validatieregel (die werkt bij mij alvast in combinatie met onderstaande)

Is Null Or ((Like "*?@?*.?*") And (Not Like "*[ ,;]*"))

Je kan dat ook verder bv doen via een functie die je bv zo aanroept in de "voor bijwerken" gebeurtenis van een Textveld met een mailadres

Private Sub TxtEmail_BeforeUpdate(Cancel As Integer)
Dim Reason As String
If Nz(TxtEmail) <> "" Then
     If IsEMailAddress(TxtEmail, Reason) = False Then
        MsgBox "Ongeldig mail adres, reden: " & Reason
           Cancel = True
           Exit Sub
     End If
End If
End Sub

En de functie zelf zet je ergens in een module (niets die belet om aan die functie nog regels toe te voegen of er weg te laten)

Public Function IsEMailAddress(ByVal sEmail As String, _
 Optional ByRef sReason As String) As Boolean
 
' Als de functie een false retourneert wordt de reden daarvoor meegegeven in de optionele reason string
'IsValid = IsEMailAddress("johan@johan.be", InvalidReason)
'MsgBox "Invalid mail address, de reden is: " & InvalidReason
 
Dim IsValid As Boolean
 Dim InvalidReason, OK As String
 Dim sPreffix As String
 Dim sSuffix As String
 Dim sMiddle As String
 Dim nCharacter As Integer
 Dim sBuffer As String
 
sEmail = Trim(sEmail)
 
If Len(sEmail) < 8 Then
 sReason = "Te kort mailadres"
 Exit Function
 End If
 
If LCase(Right(sEmail, 1)) Like "[a-z]" Then
 GoTo CheckAt
 End If
 sReason = "Niet toegelaten karakter op einde" ' Check voor '.' etc op het einde
 Exit Function
 
CheckAt:
 If InStr(sEmail, "@") = 0 Then
 sReason = "Missend @ in het mailadres"
 Exit Function
 End If
 
If InStr(InStr(sEmail, "@") + 1, sEmail, "@") < 0 Then
 sReason = "Te veel @ in het mailadres"
 Exit Function
 End If
 
If InStr(sEmail, ".") = 0 Then
 sReason = "Missend . in het mailadres"
 Exit Function
 End If
 
If InStr(sEmail, "@.") >= 1 Then
 sReason = "Missend achtervoegsel in het mailadres"
 Exit Function
 End If
If InStr(sEmail, ".@") >= 1 Then
 sReason = "Zeker dat er een .@ staat in het mailadres?"
 Exit Function
 End If
If InStr(sEmail, "..") = 1 Then
 sReason = "Twee .. na elkaar is niet gebruikelijk in een mailadres!"
 Exit Function
 End If
If InStr(sEmail, "@") = 1 Or InStr(sEmail, "@") = Len(sEmail) Or _
 InStr(sEmail, ".") = 1 Or InStr(sEmail, ".") = Len(sEmail) Then
 sReason = "Niet toegelaten formaat van het mailadres"
 Exit Function
 End If
 
For nCharacter = 1 To Len(sEmail)
 sBuffer = Mid$(sEmail, nCharacter, 1)
 If Not (LCase(sBuffer) Like "[a-z]" Or sBuffer = "@" Or _
 sBuffer = "." Or sBuffer = "-" Or sBuffer = "_" Or IsNumeric(sBuffer)) Then
 sReason = "Niet toegelaten karakter in het mailadres"
 Exit Function
 End If
 Next nCharacter
 
nCharacter = 0
 
On Error Resume Next
 
sBuffer = Right(sEmail, 4)
 If InStr(sBuffer, ".") = 0 Then GoTo TooLong:
 If Left(sBuffer, 1) = "." Then sBuffer = Right(sBuffer, 3)
 If Left(Right(sBuffer, 3), 1) = "." Then sBuffer = Right(sBuffer, 2)
 If Left(Right(sBuffer, 2), 1) = "." Then sBuffer = Right(sBuffer, 1)
 
If Len(sBuffer) < 2 Then
 sReason = "Topleveldomein is te kort (landextensie aan de mail bv . be), minimum 2 kakrakters "
 Exit Function
 End If
 
TooLong:
 If Len(sBuffer) > 3 Then
 sReason = "Topleveldomein is te lang (landextensie aan de mail bv . be), maximum 3 kakrakters"
 Exit Function
 End If
 
sReason = Empty ' We raakten tot hier dus zal 't adress wel OK zijn.
 IsEMailAddress = True
 
End Function

 

[OctaFish]

Da's een behoorlijk lange functie om emails te checken, die waarschijnlijk ook nog niet eens foolproof is . Zoals ik al zei, zou ik daar een Regular Expression voor gebruiken. Bijvoorbeeld deze:

Function EmailCheck(ByVal EmailAddress As String) As Boolean
' Validate email address
On Error GoTo Catch
msg = "Voorbeeld emailadres:  <informatie@afdeling.mijnstad.nl>"
Dim iAap As Integer
Dim objRegExp As Object

    Set objRegExp = CreateObject("VBSscript.RegExp")
    objRegExp.IgnoreCase = True
    objRegExp.Global = True
    If InStr(1, Me(EmailAddress).Text, "@") > 0 Then
        iAap = InStr(1, Me(EmailAddress).Text, "@")
        If InStr(iAap + 1, Me(EmailAddress).Text, ".") > 0 Then
            objRegExp.Pattern = "^([a-zA-Z0-9_\-\.]+)@[a-z0-9-]+(\.[a-z0-9-]+)*(\.[a-z]{2,3})$"
        Else
            objRegExp.Pattern = "^([a-zA-Z0-9_\-\.]+)@[a-z0-9-]$"
        End If
    Else
        objRegExp.Pattern = "^([a-zA-Z0-9_\-\.]+)$"
    End If
    blnIsValid = objRegExp.test(EmailAddress)
    EmailCheck = blnIsValid
    If blnIsValid = False Then
        sTmp = Me(EmailAddress).Text
        MsgBox "Het email adres bevat een verkeerd teken..." & cr & "Graag opnieuw invoeren!", vbInformation, msg
        If Len(sTmp) > 1 Then
            sTmp = Left(sTmp, Len(sTmp) - 1)
            Me(EmailAddress).Text = sTmp
        Else
            Me(EmailAddress).Text = ""
        End If
    End If
    Exit Function

Catch:
    EmailCheck = False
    MsgBox "ValidateEmailAddress function" & vbCrLf & vbCrLf & "Error#:  " & Err.Number & vbCrLf & Err.Description

End Function

Er zijn veel meer templates voor email checks, ook een beetje afhankelijk van de domeinen die je wilt controleren.
Deze functie gebruikt Late Binding, zodat hij ook werkt als je de juiste bibliotheek niet hebt.