begin process at 2012 02 16 12:50:49
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

Base de Donnees

 > CONTRÔLER LA SAISIE D'UN E-MAIL

CONTRÔLER LA SAISIE D'UN E-MAIL


 Description

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

Source

  • 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
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.


 Sources de la même categorie

Source avec Zip Source avec une capture BIEN ADMINISTRER LES ETUDIANTS ET LEURS CÔTES par okosa
Source avec Zip VBA EXEL GESTION DE PERSONEL NOUVEAU CONTRAT DE TRAVAI par oudlarbi
Source avec Zip Source avec une capture CREATION D'UN OBJET D'ACCÈS AUX DONNÉES par okosa
Source avec Zip Source .NET (Dotnet) MISAHORAIRE par MdelM
Source avec Zip Source avec une capture BASEDEDONNEES,GESTIONDEMALADES,DATABASSE par shadkitenge

 Sources en rapport avec celle ci

Source avec Zip DÉTECTEUR DE PROCÉDURES ET FONCTIONS INUTILISÉES par 8Tnerolf8
Source avec Zip ACCES AVEC SOUS FORMULAIRE par Talere
FONCTIONS INSERT UPDATE POUR ACCESS PROJET ADP par pifou25
Source avec Zip Source avec une capture Source .NET (Dotnet) MAILS MANAGER par theangelus
Source .NET (Dotnet) FONCTION POUR EXTRAIRE DES EMAILS DANS UN TEXTE par vladam

Commentaires et avis

Commentaire de Renfield le 23/01/2007 12:41:25 administrateur CS

Tu ^pourrais également utiliser une 'expression rationelle' (Regular expression)

Commentaire de Bidou le 23/01/2007 18:25:43 administrateur CS

Moui, de toutes façons ces fonctions ont très peu d'utilités...
Si j'entre x@x.x , ça va matcher donc voilà, ...

Commentaire de Malkuth le 24/01/2007 17:32:39

A mon avis il serait plus judicieux de travailler a partir des caractères autorisé(que ce passe t'il si un ° ou un € se glisse dans l'adresse...)

dans ce cas une liste de caractères autorisé est plus simple a metre en place, parce que les chaines coddée en unicode peuvent contenir trop de caractere interdits pour tous les enuméré (cyrilique,arabes,accent,ponctuation,symbole mathématique...)

sinon une expression réguliére fais tous ca et même plus en une seul fonction. Si tu ne les connais pas renseigne toi c'est un peu chiant au départ mais question validation de données y'a pas mieux.

Commentaire de Malkuth le 24/01/2007 17:42:43

Pour allonger la liste des test :

pas de point a la fin
pas de @ a la fin
au moins 6 caractères(mail mini -> a@a.aa
au moins un point aprés le @
pas de PointPoint dans la partie dériére le @
La derniére partie de l'email (aprés le derniér points) doit contenir 2 à 4 carateres.

consernat la partir Utilisateur de l'email(avant le @) il y'a des régles a suivre mais dans la pratique il arrive que certaine implémentation déroge à la régle donc méfiance(certain serveur accepte les noms commencant par point...).

Commentaire de Malkuth le 24/01/2007 17:53:13

encore moi !

ne déclare pas comme ca :


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

celà équivaut à :

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

donc déclare :

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

La vérification de .@ et @. est défailante,

que se passe-t'il avec cette adresse : Toto.tata..tom.@.poto..c

A mon sens Accent et interdit devrais être traiter ensemble (une seul boucle donc plus rapide

Commentaire de andalo le 13/05/2008 10:18:34

desolé, j'essayais de voir si le html pouvais me coloriser le code pour poster ici.
Donc voila, j'ai essayé cette fonction qui me renvoi systematiquement ques mes emails sont invalides, alors je m'en suis inspiré, pour ecrire le code qui suit, à mon sens c'est plus rapide et du coup plus complet vu que j'ai rajouté des choses en rapport aux commentaires de Malkhut. J'espère ne pas avoir trop dérogé aux regles pour poster ici et coder du vb!


Function mailvalide(email) As Boolean
Const CarAutorise = "abcdefghijklmnopqrstuvwxyz0123456789.@"
Dim pos_point, pos_point2, pos_arobase, pos_arobase2 As Integer
    mailvalide = False
    
    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 Mid(email, Len(email), 1) = "." Or Mid(email, Len(email), 1) = "@" Then Exit Function
    If InStr(pos_arobase, email, "..") > 0 Then Exit Function 'si .. present apres @ on sort de la fonction
    For i = 1 To Len(email)
        If InStr(1, CarAutorise, LCase(Mid(email, i, 1))) < 0 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

Commentaire de Renfield le 13/05/2008 10:38:03 administrateur CS

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


Commentaire de andalo le 13/05/2008 12:17:28

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

Commentaire de Renfield le 13/05/2008 12:22:22 administrateur CS

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...


Commentaire de andalo le 13/05/2008 14:33:48

en effet, on doit aimer se compliquer la vie, merci pour l'aide.

Commentaire de Malkuth le 13/05/2008 19:04:09

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...

 Ajouter un commentaire


Discussions en rapport avec ce code source dans le forum

HELP : Appel d'une fonction Excel depuis un formulaire sous Acces... [ par ragnagnac ] Bonjour à tous,Voilà, j'ai un petit soucis que je vais essayer d'expliquer le plus clairement possible.Je développe une application sous Access2000 en ACCESS [ par gosbos2003 ] Est-il possible dans un formulaire de modifier un champs en fonction de la valeur d'une liste modifiable?Par exemple, j'ai une table de client, certai programmation VBA avec ACCESS 2000 [ par michel_b ] j ai un probleme avec la roulette de la souris dans les formulaires en effet quand je l utilise elle fait d&#233;filer les enregistrements mais il y a Dans un formulaire Access, lancer une fonction toutes les minutes [ par le_highlander ] Bonjour, J'aimerais cr&#233;er un bouton qui lorsque l'utilisateur clique dessus lance toutes les minutes une fonction que j'ai &#233;crite. Et acces formulaire sous access 2003 [ par aminix9 ] Bonjour tous le monde,je travaille sur une BD sous access 2003, j'ai crée un formulaire surlequel j ai mis un bouton de commande pour quitter le formu Probleme d'affichage sur un tableau access [ par ragna25 ] BonjourVoila je suis sur access (97) , j'ai fait un tableau sur un formulaire, j'interroge ma base avec un requette, ça marche correctement, ça affich pb pour ouvrir un formulaire en VBA dans access [ par leroi1024 ] Bonjour. Je rencontre un problème pour ouvrir un formulaire dans access par programmation. Je voudrais qu'en cliquant sur un bouton, un autre formulai Recordset et creation formulaire dynamique sous access [ par fredieuric ] Bonjour à tous,Sous Access 2003 SP2,J'ai récupéré un code source que j'essaye d'adapter à mes besoins (à savoir créer dynamiquement un formulaire en f Formulaire Access et pourcentage d'avancement [ par Goste ] Bonjour, Je dois créer unTableau d'avancement par pourcentage à partir de jalons contenus dans une base de donnée Access. Ma base de donnée ressemble formulaire de recherche multi critère sous Access [ par anadeveloppeur ] Bonsoir, j'espère que j'ai posté dans le bon forum (je n'ai pas toruvé plus mieux) Je veux créer un formulaire de recherche sous Access, qui prend en


Nos sponsors


Sondage...

CalendriCode

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 1,217 sec (4)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales