Ce code n'a pas la prétention d'éviter d'entrer de fausses adresses mais vous assure une quasi totale fiabilité en ce qui concerne son format. Il est évident que les tests auraient pu être beaucoup poussés au point de vérifier si le nom de domaine de l'adresse est valide, mais pour des raisons de simplicité d'utilisation du code et de transmission de celui-ci, je me suis dis que faire une fonction simple sans appel à quoi que ce soit d'autre ferait très bien l'affaire.
- NOUVEAU : CODE IDEM POUR ADRESSE SMTP !
Source / Exemple :
' ***************************************************
' 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
- SOURCE SUIVANTE ********************
' **************************************************************
' Test de vérification du format d'une adresse d'un serveur SMTP
' **************************************************************
'
' 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 du serveur SMTP minimum 6 caract. (ex: a.a.fr)
' 5) Le nombre de . doit être minimum 2
' 6) . ne peut être le premier caractère
' 7) 2 . ne peuvent se suivre
' 8) 2 caractères minimum doivent être présents après le dernier .
'
Option Explicit
Dim strSMTPMsg As String 'variable contenant le message d'erreur personnalisé
Private Function ValidSMTP() As Boolean
'déclaration des variables
Dim strSMTP As String 'variable contenant l'adresse du serveur SMTP
Dim y 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
strSMTP = Trim(Text1.Text)
'si l'adresse contenait des espaces involontaires, elle est réaffichée juste
Text1.Text = strSMTP
'***TEST 2***
'test si l'adresse du serveur SMTP est vide
If strSMTP = "" Then
strSMTPMsg = "Aucune adresse de serveur SMTP n'est entrée !"
Exit Function
End If
'***TEST 3***
'test des caractères invalides
For y = 1 To Len(strSMTP)
If Not InStr(strValidChars, Mid(strSMTP, y, 1)) > 0 Then
strSMTPMsg = "L'adresse du serveur SMTP contient des caractères invalides !"
Exit Function
End If
Next
y = 0
'***TEST 4***
'test de la longueur de l'adresse du serveur SMTP (6 caract. min.)
If Len(strSMTP) < 6 Then
strSMTPMsg = "Le nombre de caractères de l'adresse du serveur SMTP ne peut être inférieur à 6 !"
Exit Function
End If
'***TEST 5***
'test que le nombre de points soit >= 2
If InStr(1, strSMTP, ".") = 0 Or InStr(1, Right(strSMTP, Len(strSMTP) - InStr(1, strSMTP, ".")), ".") = 0 Then
strSMTPMsg = "L'adresse du serveur SMTP doit contenir 2 points !"
Exit Function
End If
'***TEST 6***
'test que . ne peut être le premier caractère de l'adresse du serveur SMTP
If Left(strSMTP, 1) = "." Then
strSMTPMsg = "Votre adresse du serveur SMTP ne peut commencer par un point !"
Exit Function
End If
'***TEST 7***
'test que .. n'existe pas dans l'adresse du serveur SMTP
If InStr(1, strSMTP, "..") > 0 Then
strSMTPMsg = "2 point ne peuvent être l'un derrière l'autre dans l'adresse du serveur SMTP !"
Exit Function
End If
'***TEST 8***
'test que 2 caractères minimum soient présents à droite du dernier .
If Right(strSMTP, 1) = "." Or InStr(Right(strSMTP, 2), ".") = 1 Then
strSMTPMsg = "Il doit y avoir minimum 2 caractères après le dernier point dans l'adresse du serveur SMTP !"
Exit Function
End If
'*** SMTP VALIDE ***
'on donne la valeur vraie au résultat
ValidSMTP = True
Exit Function
End Function
Private Sub Command1_Click()
'vérification de la validité du format de l'adresse du serveur SMTP
If ValidSMTP = True Then
'on affiche le message de succès
MsgBox "Le format de votre adresse SMTP est valide !"
Else
'affichage du message d'erreur combiné
MsgBox "Le format de votre adresse de serveur SMTP n'est pas valide !" & vbCrLf & strSMTPMsg, vbExclamation
'on met le curseur sur Text1
Text1.SetFocus
End If
End Sub
Conclusion :
Pour utiliser le code, vous avez besoin de :
- 1 TextBox nommé Text1
- 1 Bouton nommé Command1
/!\ Valable pour les 2 sources.
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.