XL 2016 VBA :Inputbox et adresse mail

[dodineau]

Bonjour,
Je cherche depuis longtemps mais impossible de trouver une solution.
J'ai un inputbox dans lequel je voudrais saisir uniquement des adresses mail valides.
Je n'arrive pas à trouver la formule en VBA pour faire cette vérification.
Merci pour votre aide.
A+

 

[Staple1600]

Bonjour le fil, dodineau

•>dodineau
Une première piste

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

NB: ne fonctionne que sur Windows.

PS: Le pattern reste à peaufiner (car il valide des emails alors qu'il ne devrait pas)

 

[dodineau]

Bonjour et merci pour cette réponse.
C'est un peu compliqué pour moi , je ne connais pas certaines fonction de cet exemple (StrPtr).
J'ai tout de même essayé ce code et il y a un faux mail qui passe si par exemple on commence l'adresse par un point, il y en a peut-être d'autres mais je n'ai pas tout essayé.
A+

 

[Staple1600]

Bonjour le fil, dodineau

•>dodineau
Cela confirme donc ce qu'on pouvait dans le PS de mon précédent message.

PS: Le pattern reste à peaufiner (car il valide des emails alors qu'il ne devrait pas)

 

[zebanx]

Bonjour Dodineau, Staples1600

A reprendre peut-etre en inputbox avec la fonction suivante trouvée sur un lien indiqué dans le fichier qui utilise les regex.

xl-ment

 

[Staple1600]

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.

 

[zebanx]

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.

Ok (référence : .. regular 5.5 coché mais c'était déjà le cas très surement dans ton exemple).
Ca fait longtemps que pas utilisé les regex, bien rouillé de mon côté !

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

 

[Staple1600]

Re

Merci pour ta célérité
Du coup, j'emprunte ton pattern pour peaufiner la fonction du message#2

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