Contrôler la saisie d'un e-mail

Commenter

Contenu du snippet

Voici une fonction qui permet de contrôler le format d'une adresse mail saisie dans un formulaire Access (toutes versions).

Source / Exemple : 


Function EmailValide(sAdresse) As Boolean
Const Accents = "àáâãäåèéêëìíîïðñòóôõöùúûüýÿ"
Const CarInterdits = ",;#`'/*+:\&<>~{}=)([]|?§"

Dim TestAdrMail As Boolean, TestAccents, TestCarInterdits As Boolean
Dim i As Integer
Dim pos_point, pos_point2, pos_arobase, pos_arobase2 As Integer

    If Len(sAdresse) = 0 Or IsNull(sAdresse) Then
        TestAdrMail = True
    Else
        pos_arobase = InStr(1, sAdresse, "@")
        'Vérifie qu'il n'y a pas plusieurs @ dans l'adresse mail
        pos_arobase2 = InStr(1, Right(sAdresse, Len(sAdresse) - pos_arobase), "@")
        'Position du . après l'@
        pos_point = InStr(pos_arobase + 1, sAdresse, ".")
        'Position du . avant l'@
        pos_point2 = InStr(pos_arobase - 1, sAdresse, ".")
        
        'Critères de validité :
        '@ pas en première position
        'Pas de . en 1ère position
        'Pas de @.
        'Pas de .@
        'Au moins 2 caractères dans l'adresse
        'Pas d'@ après le 1er @
        If (pos_arobase > 1 And pos_point > 1 And Len(sAdresse) > 2 And pos_point - pos_arobase > 1 And pos_arobase - pos_point2 > 1 And pos_arobase2 = 0) Then
            TestAdrMail = True
        Else
            TestAdrMail = False
        End If
    End If

'Vérifie qu'il n'y a pas de caractères accentués dans l'adresse mail
TestAccents = True

For i = 1 To Len(sAdresse)
    If InStr(1, Accents, LCase(Mid(sAdresse, i, 1))) > 0 Then
        TestAccents = False
        Exit For
    End If
Next

'Vérifie qu'il n'y a pas de caractères exclus dans l'adresse mail
TestCarInterdits = True

For i = 1 To Len(sAdresse)
    If InStr(1, CarInterdits, LCase(Mid(sAdresse, i, 1))) > 0 Then
        TestCarInterdits = False
        Exit For
    End If
Next

EmailValide = TestAdrMail And TestAccents And TestCarInterdits And ChercheEspace(sAdresse) = False
End Function

Function ChercheEspace(ByVal LETEXTE As String)
Const strSpacer = " "
Dim TestEspace As Boolean
Dim i As Integer

TestEspace = False

For i = 1 To Len(LETEXTE)
    If InStr(1, strSpacer, LCase(Mid(LETEXTE, i, 1))) > 0 Then
        TestEspace = True
        Exit For
    End If
Next

ChercheEspace = TestEspace
End Function

Conclusion :


Explications (voir aussi les commentaires !!!!)
Pour qu'une adresse mail soit valide, il faut :
- Qu'elle ait au moins 2 caractères
- 1 et un seul @
- Pas de @. ni de .@
- Pas d'accents
- Pas de caractères spéciaux comme ,;#`'/*+:\&<>~{}=)([]|?§
- L'@ ne doit pas être en 1ère position

Les tests sont commentés pour une meilleure compréhension de la logique mise en oeuvre.

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.