Texte ExtraireCourriel

Magic_Doctor

Magic_Doctor

XLDnaute Barbatruc
Vérifie s'il y a une adresse mail dans une chaîne et, le cas échéant, l'extrait.

J'ai trouvé le Pattern ici (très instructif).
J'ai adapté, ma foi, ça a l'air de bien marcher.
Ex : f("mail de Romina : romina_coquina007@Farandula.jujuy (à envoyer expressément uniquement en cas de morosité australe") --> romina_coquina007@farandula.jujuy
VB: 
Function ExtraireCourriel(txt As String) As String
'*********************************************************************************
'Vérifie s'il y a une adresse mail dans une chaîne et, le cas échéant, l'extrait
'*********************************************************************************
 
    Set regEx = CreateObject("VBScript.RegExp")
    With regEx
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = "\b[a-z0-9._%+-]+@[a-z0-9.-]+\.[a-z]{2,}\b"
    End With
 
    txt = LCase(txt)  'met toute la chaîne en minuscules au cas où un maladroit aurait mis des majuscules dans l'adresse mail

    With regEx
        If regEx.test(txt) Then  'le "Pattern" est bien retrouvé dans la chaîne
            ExtraireCourriel = .Execute(txt)(0)
        Else
            ExtraireCourriel = "Not matched"
        End If
    End With
 End Function
 
Dernière édition:
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
Bonjour
tu peux supprimer cela
VB: 
 txt = LCase(txt)  'met toute la chaîne en minuscules au cas où un maladroit aurait mis des majuscules dans l'adresse mail

en mettant le pattern en MAJ et min
"A-z" comprend 56 caractères Maj et min selon le code asc
VB: 
  .Pattern = "\b[A-z0-9._%+-]+@[A-z0-9.-]+\.[A-z]{2,}\b"
'ou
'.Pattern = "\s[A-z0-9._%+-]+@[A-z0-9.-]+\.[A-z]{2,}\s"
 
Dernière édition:
Magic_Doctor

Magic_Doctor

XLDnaute Barbatruc
Bonjour,

Je viens d'essayer. Effectivement le Pattern est reconnu même s'il y a des majuscules dans l'adresse mail. En revanche, et c'est logique, s'il y a dans la chaîne une adresse mail, la fonction renverra l'adresse telle qu'elle a été (mal ou bien) écrite :
f("mail de Romina : RominiTA_coquina007@Farandula.jujuy (à envoyer expressément uniquement en cas de morosité australe)") --> RominiTA_coquina007@Farandula.jujuy
Autant récupérer une adresse mail bien écrite, comme : rominita_coquina007@farandula.jujuy
Enfin, si à la place de \b on met \s, il y aura fatalement un espace inutile en début et fin d'adresse mail extraite. Alors, autant conserver \b, même si, apparemment, en ne les mettant pas ça marche quand même.
 
Dernière édition:
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
ben il y a des adresses mail avec majuscule ça existe
c'est le tout en maj ou min qui ne fait pas de différence
par exemple mon adresse mail c'est "totolafritte@hotmail.fr" et si tu m'envoie un mail par "TOTOLAFRITTE@HOTMAIL.fr" je le recevrais

fait un lcase ou ucase du match(0) si tu tiens a normaliser

pour le "\b" je suis d'accords c'est mieux j'ai testé avec une ","ou "; " etc..etc...
 
Magic_Doctor

Magic_Doctor

XLDnaute Barbatruc
Re,

Je veux bien que les 2 écritures soient reconnues, et c'est tant mieux ! Mais il me semble que, par convention, une adresse mail devrait s'écrire tout en minuscules. À moins qu'il existe des adresses mail confidentielles qui ne peuvent s'écrire qu'en majuscules. Personnellement je n'en ai jamais vu.
Enfin, j'ai remarqué que l'on pouvait se passer des 2 "\b". Ça a l'air de marcher quand même. Sont-ils vraiment utiles ?
 
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
c'est vrai ça fonctionne sans le \b
le \b est un opérateur de limite de mot
mais bon j'ai jamais expérimenté un réel besoins ni vraiment compris comment il fonctionne

non ce que j'ai dit c'est que des adresses mail avec des maj et min ca existe
celles là on ne peut les convertir ucase ou lcase (elles ne sont pas reconnues lors de l'envoie de mail)
celle qui sont toutes en min ou maj oui (en min ou maj elles sont reconnues )
 
Magic_Doctor

Magic_Doctor

XLDnaute Barbatruc
Re,

Là je suis curieux, quand rencontre-t-on ce type d'adresse mail mélangeant minuscules et majuscules ? Celui qui a inventé ça, c'est vraiment pour emmerder les gens ! :cool: Je sais, dans l'administration ou ailleurs, ils sont légion...
 
Magic_Doctor

Magic_Doctor

XLDnaute Barbatruc
J'ai trouvé cette réponse (quantité d'autres sont identiques) :
mail.jpg

Personnellement, je conserverai les adresses mail toujours en minuscule.
 
Magic_Doctor

Magic_Doctor

XLDnaute Barbatruc
Bonsoir,

J'ai modifié la fonction. Par la même occasion je l'ai rebaptisée. Nettement plus explicite.
VB: 
Function ExtractAndDissectMail$(txt$, Optional dissection As Byte = 0)
'*********************************************************************************
'Vérifie s'il y a une adresse mail dans une chaîne et, le cas échéant, l'extrait
'Magic_Doctor
'*********************************************************************************
'- txt : une chaîne de caractères contenant ou pas une adresse courriel (ex : Corresponding Author: Sr. Diego Zorro diegozorro@macho-uno.justiciapopular.mx THE BEST TO SAVE THE WORLD)
'- dissection : si 0 (ou omis) --> extraction de l'adresse mail dans son intégralité............ diegozorro@macho-uno.justiciapopular.mx
'               si 1 --> extraction uniquement de l'identifiant................................. diegozorro
'               si 2 --> extraction uniquement du sous-domaine, du domaine et de l'extension.... macho-uno.justiciapopular.mx
'               si 3 --> extraction uniquement du sous-domaine.................................. macho-uno
'               si 4 --> extraction uniquement du domaine de 2ème niveau........................ justiciapopular
'               si 5 --> extraction uniquement du domaine de 1er niveau (extension ou TLD)...... mx

Dim regEx As Object, courriel$, PieceOfString$, strTab$(), nb As Byte
  
    Set regEx = CreateObject("VBScript.RegExp")
    txt = LCase(txt)  'met toute la chaîne en minuscules au cas où un maladroit aurait mis des majuscules dans l'adresse mail

    With regEx
        .Pattern = "[a-z0-9._%+-]+@[a-z0-9.-]+\.[a-z]{2,}"         'adresse mail complète
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
    End With
    If regEx.test(txt) Then                                        'le "Pattern" est bien retrouvé dans la chaîne
        courriel = regEx.Execute(txt)(0)
        ExtractAndDissectMail = courriel                           'extraction de l'adresse courriel dans son intégralité (diegozorro@macho-uno.justiciapopular.mx)
    Else                                                           'le "Pattern" n'est pas retrouvé dans la chaîne
        ExtractAndDissectMail = "Not matched": Exit Function
    End If
  
    If dissection = 1 Then
        regEx.Pattern = "[a-z0-9._%+-]+"                           'identifiant
        ExtractAndDissectMail = regEx.Execute(courriel)(0)         'extraction de l'identifiant de l'adresse courriel (diegozorro)
    ElseIf dissection = 2 Then
        regEx.Pattern = "[a-z0-9._%+-]+@"                          'identifiant + @
        PieceOfString = regEx.Replace(courriel, "")                'l'adresse mail est débarrassée de son identifiant et du @
        ExtractAndDissectMail = PieceOfString                      'extraction du domaine dans son intégralité (macho-uno.justiciapopular.mx)
    ElseIf dissection = 3 Then
        regEx.Pattern = "[a-z0-9._%+-]+@"                          'identifiant + @
        PieceOfString = regEx.Replace(courriel, "")                'l'adresse mail est débarrassée de son identifiant et du @
        strTab = Split(PieceOfString, "."): nb = UBound(strTab())  'nombre de "." dans la chaîne "PieceOfString"
        If nb = 1 Then                                             'il n'y a pas de sous-domaine
            PieceOfString = "Not matched"
        Else                                                       'il y a un sous-domaine
            regEx.Pattern = "(.*)\.(.*)\.(.*)"                     'structure de la chaîne "PieceOfString" (3 mots séparés par un ".")
            PieceOfString = regEx.Replace(PieceOfString, "$1")     'on prend le 1er mot
        End If
        ExtractAndDissectMail = PieceOfString
    ElseIf dissection = 4 Then
        regEx.Pattern = "[a-z0-9._%+-]+@"                          'identifiant + @
        PieceOfString = regEx.Replace(courriel, "")                'l'adresse mail est débarrassée de son identifiant et du @
        strTab = Split(PieceOfString, "."): nb = UBound(strTab())  'nombre de "." dans la chaîne "PieceOfString"
        If nb = 1 Then                                             'il n'y a pas de sous-domaine
            regEx.Pattern = "(.*)\.(.*)"                           'structure de la chaîne "PieceOfString" (2 mots séparés par un ".")
            PieceOfString = regEx.Replace(PieceOfString, "$1")     'on prend le 1er mot
        Else                                                       'il y a un sous-domaine
            regEx.Pattern = "(.*)\.(.*)\.(.*)"                     'structure de la chaîne (3 mots séparés par un ".")
            PieceOfString = regEx.Replace(PieceOfString, "$2")     'on prend le 2ème mot
        End If
        ExtractAndDissectMail = PieceOfString
    ElseIf dissection = 5 Then
        regEx.Pattern = "[a-z0-9._%+-]+@[a-z0-9.-]+\."             'adresse mail complète sans l'extension
        ExtractAndDissectMail = regEx.Replace(courriel, "")        'extraction du domaine de 1er niveau ou extension (spécial, national, générique) de l'adresse courriel (mx)
    End If
 End Function
 

Pièces jointes

  • Mail's Anatomy.xlsm
    27 KB · Affichages: 9
Dernière édition:
Magic_Doctor

Magic_Doctor

XLDnaute Barbatruc
En un peu plus succinct.
VB: 
Function ExtractAndDissectMail$(txt$, Optional dissection As Byte = 0)
'*********************************************************************************
'Vérifie s'il y a une adresse mail dans une chaîne et, le cas échéant, l'extrait
'Magic_Doctor
'*********************************************************************************
'- txt : une chaîne de caractères contenant ou pas une adresse courriel (ex : Corresponding Author: Sr. Diego Zorro diegozorro@macho-uno.justiciapopular.mx THE BEST TO SAVE THE WORLD)
'- dissection : si 0 (ou omis) --> extraction de l'adresse mail dans son intégralité............ diegozorro@macho-uno.justiciapopular.mx
'               si 1 --> extraction uniquement de l'identifiant................................. diegozorro
'               si 2 --> extraction uniquement du sous-domaine, du domaine et de l'extension.... macho-uno.justiciapopular.mx
'               si 3 --> extraction uniquement du sous-domaine.................................. macho-uno
'               si 4 --> extraction uniquement du domaine de 2ème niveau........................ justiciapopular
'               si 5 --> extraction uniquement du domaine de 1er niveau (extension ou TLD)...... mx

Dim regEx As Object, courriel$, PieceOfString$, nb As Byte
    
    Set regEx = CreateObject("VBScript.RegExp")
    txt = LCase(txt)  'met toute la chaîne en minuscules au cas où un maladroit aurait mis des majuscules dans l'adresse mail

    With regEx
        .Pattern = "[a-z0-9._%+-]+@[a-z0-9.-]+\.[a-z]{2,}"        'adresse mail complète
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
    End With
    If regEx.test(txt) Then                                       'le "Pattern" est bien retrouvé dans la chaîne
        courriel = regEx.Execute(txt)(0)                          'adresse courriel
        ExtractAndDissectMail = courriel                          'extraction de l'adresse courriel dans son intégralité --> diegozorro@macho-uno.justiciapopular.mx
    Else                                                          'le "Pattern" n'est pas retrouvé dans la chaîne
        ExtractAndDissectMail = "Not matched": Exit Function
    End If
    
    regEx.Pattern = "(.*)@(.*)\.(.*)"                             'structure de l'adresse courriel extraite (identifiant@éventuel sous-domaine avec domaine.extension)
    PieceOfString = regEx.Replace(courriel, "$2")                 'domaine sans son extension
    nb = UBound(Split(PieceOfString, "."))                        'nombre de "." dans la chaîne correspondant au domaine sans son extension
    
    If dissection = 1 Then
        ExtractAndDissectMail = regEx.Replace(courriel, "$1")               'extraction de l'identifiant de l'adresse courriel --> diegozorro
    ElseIf dissection = 2 Then
        ExtractAndDissectMail = regEx.Replace(courriel, "$2" & "." & "$3")  'extraction du domaine dans son intégralité (sous-domaine + domaine + extension) --> macho-uno.justiciapopular.mx
    ElseIf dissection = 3 Then
        PieceOfString = regEx.Replace(courriel, "$2")
        If nb = 0 Then                                                       'il n'y a pas de sous-domaine
            ExtractAndDissectMail = "Not matched"
        Else                                                                 'il y a un sous-domaine
            regEx.Pattern = "(.*)\.(.*)"                                     'structure de la chaîne correspondant au sous-domaine avec le domaine sans extension (2 mots séparés par un ".")
            ExtractAndDissectMail = regEx.Replace(PieceOfString, "$1")       'extraction du sous-domaine --> macho-uno
        End If
    ElseIf dissection = 4 Then
        PieceOfString = regEx.Replace(courriel, "$2")
        If nb = 0 Then                                                       'il n'y a pas de sous-domaine
            ExtractAndDissectMail = regEx.Replace(PieceOfString, "$1")
        Else                                                                 'il y a un sous-domaine
            regEx.Pattern = "(.*)\.(.*)"                                     'structure de la chaîne correspondant au sous-domaine avec le domaine sans extension (2 mots séparés par un ".")
            ExtractAndDissectMail = regEx.Replace(PieceOfString, "$2")       'extraction du domaine (sans le sous-domaine ni l'extension) --> justiciapopular
        End If
    ElseIf dissection = 5 Then
        ExtractAndDissectMail = regEx.Replace(courriel, "$3")                'extraction du domaine de 1er niveau ou extension (spécial, national, générique) de l'adresse courriel --> mx
    End If
 End Function
 

Pièces jointes

  • Mail's Anatomy2.xlsm
    27.2 KB · Affichages: 9
D

david84

XLDnaute Barbatruc
Bonjour,
j'ai lu en diagonal et je n'ai pas testé le pattern mais pour que le pattern traite indifféremment les minuscules et les majuscules il suffit de passer IgnoreCase à True
 

Discussions similaires

Dudu2
  • Suggestion
Texte Définir les propriétés d'une cellule ou d'un Range (couleurs, fonte, ..., valeur) dans une formule
Réponses
0
Affichages
859
Dudu2
Dudu2
Magic_Doctor
  • Suggestion
Texte ExtraireFinChemin
2
Réponses
24
Affichages
4 K
Bernard_XLD
Bernard_XLD
mromain
Génération de QR Codes
Réponses
1
Affichages
677
Cousinhub
Cousinhub
Magic_Doctor
  • Question
XL 2010 Problème avec une expression régulière
2
Réponses
24
Affichages
2 K
patricktoulon
patricktoulon
patricktoulon
  • Suggestion
Texte GetNumOnText
Réponses
9
Affichages
2 K
Magic_Doctor
Magic_Doctor
Usine à gaz
  • Résolu(e)
Microsoft 365 lister des fichiers
2
Réponses
19
Affichages
2 K
Usine à gaz
Usine à gaz
G
  • Question
XL 2019 macro fonction
Réponses
3
Affichages
897
Guismo33
G
C
  • Question
XL 2019 Atteindre depuis excel plusieurs calendriers partagé outlook de destination
Réponses
2
Affichages
860
chich
C
patricktoulon
  • Suggestion
Texte SplitTextNum
Réponses
0
Affichages
1 K
patricktoulon
patricktoulon
Bernard_XLD
  • Suggestion
Date et heure Jours fériés automatiques
Réponses
10
Affichages
9 K
baptistou
B

Membres actuellement en ligne

11 membres et 160 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 629
Messages
2 111 345
Membres
111 109
dernier inscrit
djameldel