Contrôler la saisie d'un e-mail

Soyez le premier à donner votre avis sur cette source.

Snippet vu 11 246 fois - Téléchargée 24 fois

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

Ajouter un commentaire Commentaires
cs_Malkuth Messages postés 268 Date d'inscription samedi 22 février 2003 Statut Membre Dernière intervention 24 avril 2013 4
13 mai 2008 à 19:04
par expression réguliére on peut faire comme ceci :
( code en .NET )
Imports System.Text.RegularExpressions
Module Validation
Const AutorizedMailCharPattern = "[a-z0-9_]";
Const ValidMailPattern = "^#+(\.#+)*@#+(\.#+)*?\.#{2,4}$";
Dim RX_MailCheck As New Regex(ValidMailPattern.Replace("#",AutorizedMailCharPattern,RegexOptions.Compiled Or RegexOptions.IgnoreCase));

Function IsEmailValid(Email As String) As Boolean
Return RX_MailCheck.IsMatch(Email);
End Function

End Module

Je suis désolé de présenté se code en .Net, toutefois je suis persuadé que les expressions réguliéres existe en VB et la syntaxe doit être sufisement proche pour que l'exemple soit retenu.

On voit d'emblé que le code est bien plus simple que les codes sans expression réguliére, il est aussi trés rapide (en fait il pourais bien être plus rapide que le code sans expression réguliére, il prend de nombreux cas en compte dont certain ne sont pas envisagé dans les codes précédent.

Je post ceci afin de popularisé un peu les expressions réguliéres, certains les connaissent trés bien mais beaucoup ignore tout de leur puissance, elles sont pourtant un outil incontournable dans la validation de données...
andalo Messages postés 103 Date d'inscription lundi 23 avril 2007 Statut Membre Dernière intervention 20 octobre 2012
13 mai 2008 à 14:33
en effet, on doit aimer se compliquer la vie, merci pour l'aide.
Renfield Messages postés 17287 Date d'inscription mercredi 2 janvier 2002 Statut Modérateur Dernière intervention 27 septembre 2021 75
13 mai 2008 à 12:22
False, valeur par default de la variable automatique, crée puor stocker le retour de la fonction. elle ne conserve pas sa valeur d'un appel a l'autre (même si appels recursifs)

pos_arobase2 inutile... fais un If Instr...
andalo Messages postés 103 Date d'inscription lundi 23 avril 2007 Statut Membre Dernière intervention 20 octobre 2012
13 mai 2008 à 12:17
ok, j'ai pris en compte tout ca. une question tout de même, false est la valeur par defaut d'une fonction, même si je me suis au prealable servi de la fonction et qu'elle a retourné true?, si je m'en ressert ensuite, j'imagine donc qu'elle est reinitialisé a false automatiquement?
sinon j'ai aussi corrigé une petite erreur dans la dernière condition.

Function mailvalide(email) As Boolean
Const CarAutorise = "abcdefghijklmnopqrstuvwxyz0123456789.@"
Dim i As Integer, pos_point As Integer, pos_point2 As Integer, pos_arobase As Integer, pos_arobase2 As Integer
If Len(email) < 6 Or IsNull(email) Then Exit Function 'si longueur de chaine invalide, on sort de la fonction
If InStr(1, email, ".@") Or InStr(1, email, "@.") Then Exit Function 'si .@ ou @. est présent, on sort de la fonction
pos_arobase = InStr(1, email, "@")

If pos_arobase < 2 Then
Exit Function 'si arobase inexistant ou en premier caractère, on sort de la fonction
Else
pos_arobase2 = InStr(pos_arobase + 1, email, "@")
If pos_arobase2 > 0 Then Exit Function 'si un deuxieme arobase est trouvé on sort de la fonction
End If

pos_point = InStr(pos_arobase + 1, email, ".")
If pos_point < pos_arobase Then Exit Function 'si il n'y a pas de point apres l'arobase, on sort de la fonction
If Right(email, 1) "." Or Right(email, 1) "@" Then Exit Function ' si @ ou . en derniere position, on sort
If InStr(pos_arobase, email, "..") > 0 Then Exit Function 'si .. present apres @ on sort de la fonction
i = 0
For i = 1 To Len(email)
If InStr(1, CarAutorise, Mid(email, i, 1), vbTextCompare) < 1 Then
Exit Function 'si on trouve autre chose qu'un caractère autorisé, on sort de la fonction
End If
Next
mailvalide = True 'si on est pas sortie avant, c'est que l'adresse mail est valide
End Function
Renfield Messages postés 17287 Date d'inscription mercredi 2 janvier 2002 Statut Modérateur Dernière intervention 27 septembre 2021 75
13 mai 2008 à 10:38
Dim pos_point, pos_point2, pos_arobase, pos_arobase2 As Integer
pos_point, pos_point2, pos_arobase sont des Variant, ici

mailvalide = False
pas besoin d'initialiser, c'est la valeur par defaut d'un boolean

i est non déclaré (pense a jouer avec Option Explicit)

Mid(email, Len(email), 1) => fonction Right

InStr(1, CarAutorise, LCase(Mid(email, i, 1)))
pas de LCase a faire dans ce genre de choses... Instr permet de spécifier vbTextCompare comme dernier argument
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.