Soyez le premier à donner votre avis sur cette source.
Vue 14 591 fois - Téléchargée 487 fois
' *************************************************** ' Test de vérification du format d'une adresse E-Mail ' *************************************************** ' ' Type de source : Fonction ' ' ' Liste des vérifications du code : ' ------------------------------------------------------------------------------- ' Tests ' ------------------------------------------------------------------------------- ' 1) Enlever les espaces ' 2) Tester si l'E-mail est vide ' 3) Utilisation des chiffres et des lettres + (@, ., -, _,) ' 4) Longueur E-mail minimum 6 caract. (ex: a@a.fr) ' 5) @ doit être présent qu'une fois ' 6) Minimum 1 caract. à gauche de @ ' 7) Minimum 4 caract. à droite de @ (ex: a.fr) ' 8) Minimum 1 point à droite de @ ' 9) @ et . ne peuvent se suivre ' 10) .. ne peut être valide à droite de @ ' 11) A droite de @, le dernier point doit avoir minimum 2 caract. à sa droite ' Option Explicit Dim strMsg As String 'Variable contenant le message d'erreur personnalisé Private Function ValidMail() As Boolean 'déclaration des variables Dim strMail As String 'variable contenant l'adresse E-Mail Dim var As String 'variable utilisée en temporaire dans les tests Dim z As Integer 'variable utiisée en tant que compteur Const strValidChars As String = "1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ-_.@" 'variable utilisée pour stocker les caractères valides d'une adresse E-Mail '***TEST 1*** 'récupération de l'adresse en enlevant les espaces aux extrémités strMail = Trim(Text1.Text) 'si l'adresse contenait des espaces involontaires, elle est réaffichée juste Text1.Text = strMail '***TEST 2*** 'test si l'E-mail est vide If strMail = "" Then strMsg = "Aucune adresse E-mail n'est entrée !" Exit Function End If '***TEST 3*** 'test des caractères invalides For z = 1 To Len(strMail) If Not InStr(strValidChars, Mid(strMail, z, 1)) > 0 Then strMsg = "L'adresse E-Mail contient des caractères invalides !" Exit Function End If Next z = 0 '***TEST 4*** 'test de la longueur de l'E-mail (6 caract. min.) If Len(strMail) < 6 Then strMsg = "Le nombre de caractères de l'E-mail ne peut être inférieur à 6 !" Exit Function End If '***TEST 5*** 'test du nombre de fois que @ est présent (doit être 1) 'test si @ est présent au moins une fois If Not InStr(1, strMail, "@") <> 0 Then strMsg = "Le caractère @ doit être présent dans l'adresse E-Mail !" Exit Function Else 'test si @ est présent encore une fois var = Right(strMail, Len(strMail) - InStr(1, strMail, "@")) If InStr(1, var, "@") <> 0 Then var = "" strMsg = "Le caractère @ ne peut être présent plus d'une fois dans l'adresse E-Mail !" Exit Function End If End If var = "" '***TEST 6*** 'test de placement de @ qui ne peut être le 1er caractère de l'adresse If Not Len(Left(strMail, InStr(1, strMail, "@") - 1)) > 0 Then strMsg = "Le caractère @ ne peut être le 1er caractère de l'adresse E-Mail !" Exit Function End If '***TEST 7*** 'test de la partie à droite de @ qui doit avoir minimum 4 caractères If Len(Right(strMail, Len(strMail) - InStr(1, strMail, "@"))) < 4 Then strMsg = "La partie à droite du caractère @ ne peut contenir moins de 4 caractères dans l'adresse E-Mail !" Exit Function End If '***TEST 8*** 'test du nombre de fois qu'un point est présent dans la partie à droite de @ (min. 1x) var = Right(strMail, Len(strMail) - InStr(1, strMail, "@")) If InStr(1, var, ".") < 1 Then var = "" strMsg = "La partie à droite du caractère @ doit contenir minimum un point dans l'adresse E-Mail !" Exit Function End If var = "" '***TEST 9*** 'test que @ et . ne se suivent pas If InStr(1, strMail, "@.") > 0 Then strMsg = "@ et . ne peuvent être l'un derrière l'autre dans l'adresse E-Mail !" Exit Function End If '***TEST 10*** 'test que .. n'existe pas dans la partie à droite de @ var = Right(strMail, Len(strMail) - InStr(1, strMail, "@")) If InStr(1, var, "..") > 0 Then var = "" strMsg = "2 point ne peuvent être l'un derrière l'autre dans la partie à droite du caractère @ de l'adresse E-Mail !" Exit Function End If var = "" '***TEST 11*** 'test que 2 caractères minimum soient présents à droite du dernier point dans la partie à droite de @ If Right(strMail, 1) = "." Or InStr(Right(strMail, 2), ".") = 1 Then strMsg = "Il doit y avoir minimum 2 caractères après le dernier point dans la partie à droite du caractère @ de l'adresse E-Mail !" Exit Function End If '*** E-MAIL VALIDE *** 'on donne la valeur vraie au résultat ValidMail = True Exit Function End Function Private Sub Command1_Click() 'vérification de la validité du format de l'adresse E-Mail If ValidMail = True Then 'on affiche le message de succès MsgBox "Le format de votre adresse E-Mail est valide !" Else 'affichage du message d'erreur combiné MsgBox "Le format de votre adresse E-Mail n'est pas valide !" & vbCrLf & strMsg, vbExclamation 'on met le curseur sur Text1 Text1.SetFocus End If End Sub
26 mai 2004 à 00:08
et pour ton souci de message de 2 points il suffit de mettre :
strMsg = "1 point ne peut suivre ou en précéder un autre dans la partie à droite du caractère @ de l'adresse E-Mail !"
au lieu de :
strMsg = "2 point ne peuvent être l'un derrière l'autre dans la partie à droite du caractère @ de l'adresse E-Mail !"
;-)
26 mai 2004 à 00:03
25 mai 2004 à 23:02
pour les 6 caractères, essaie de me trouver un e-mail plus court que :
a@a.fr
t'as la réponse ;-)
@+
25 mai 2004 à 22:58
bravo sinon
25 mai 2004 à 22:58
bravo sinon
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.