Sub test()
Dim strEmail$
SaisieMail:
strEmail = InputBox("Renseignez l'adresse mail, svp.", "Saisie Mail", "prenom.nom@domain.fr")
If StrPtr(strEmail) = 0 Then
Exit Sub
ElseIf IsEmailAddress(strEmail) = False Then
MsgBox "Adresse mail incorrecte!", vbCritical, "Erreur saisie"
GoTo SaisieMail
End If
MsgBox strEmail ' pour test
End Sub
Function IsEmailAddress(txt As String) As Boolean
With CreateObject("VBScript.RegExp")
.Pattern = "^[\w-\.]+@([\w-]+\.)+[A-Za-z]{2,3}$"
IsEmailAddress = .test(txt)
End With
End Function
•Staple¸ prudemment et pour prévention¸ à dit:PS: Le pattern reste à peaufiner (car il valide des emails alors qu'il ne devrait pas)
Bonjour zebanx
•>zebanx
Je te demande une petite faveur, stp
Tu peux publier la fonction dans le corps du message, stp?
Afin que je puisse comparer le pattern utilisé.
Merci d'avance.
PS: je limite le nombre de téléchargements de PJ, car avec le confinement , j'ai le temps de faire le ménage sur mon HD.
Public Function ValidateEmailAddress(ByVal strEmailAddress As String) As Boolean
On Error GoTo Catch
Dim objRegExp As New RegExp
Dim blnIsValidEmail As Boolean
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "^((\w+([-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*)\s*[;]{0,1}\s*)+$"
blnIsValidEmail = objRegExp.test(strEmailAddress)
ValidateEmailAddress = blnIsValidEmail
Exit Function
Catch:
ValidateEmailAddress = False
MsgBox "Module: " & MODULE_NAME & " - ValidateEmailAddress function" & vbCrLf & vbCrLf _
& "Error#: " & Err.Number & vbCrLf & vbCrLf & Err.Description
End Function
Function IsEmailAddress(txt As String) As Boolean
With CreateObject("VBScript.RegExp")
.Pattern = "^((\w+([-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*)\s*[;]{0,1}\s*)+$"
IsEmailAddress = .test(txt)
End With
End Function