Texte ExtraireCourriel

[Magic_Doctor]

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

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

 

[patricktoulon]

Bonjour
tu peux supprimer cela

 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

  .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"

 

[Magic_Doctor]

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.

 

[patricktoulon]

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]

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]

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]

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 ! Je sais, dans l'administration ou ailleurs, ils sont légion...

 

[Magic_Doctor]

J'ai trouvé cette réponse (quantité d'autres sont identiques) :

Personnellement, je conserverai les adresses mail toujours en minuscule.

 

[Magic_Doctor]

Bonsoir,

J'ai modifié la fonction. Par la même occasion je l'ai rebaptisée. Nettement plus explicite.

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

 

[Magic_Doctor]

En un peu plus succinct.

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

 

[david84]

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