Discussion :

[Fdc_53]

Bonjour,

j'utilise la Fonction ExtractEMAIL, qui me récupère uniquement la première adresse mail de la cellule mais pas les suivantes.

Est ce que qqn peut m'aider je n'ai pas trouvé de solution.
Merci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Function ExtractEMAIL(cel As Range) As String
 
MyRegExPattern = "[_a-z0-9-]+(.[a-z0-9-]+)@[a-z0-9-]+(.[a-z0-9-]+)*(.[a-z]{2,4})"
Dim RegEx As Object
Set RegEx = CreateObject("vbscript.regexp")
With RegEx
    .Global = True
    .IgnoreCase = True
    .Pattern = MyRegExPattern
End With
 
ExtractEMAIL = ""
Set allMatches = RegEx.Execute(cel.Value)
If allMatches.Count <> 0 Then
    ExtractEMAIL = allMatches(0)
End If
 
End Function

[Invité]

Bonjour,

Je ne vais pas pouvoir vous aider, mais seulement vous indiquer le tuto concernant les expressions régulières :https://cafeine.developpez.com/access/tutoriel/regexp/

Il aurait été intéressant de connaître le contenu d'une cellule type car je me demande si vous ne pourriez pas obtenir un résultat plus facilement avec Split.

[pijaku]

Bonjour,

En fait, si, il te les trouve toutes.
Cependant tu ne renvoies, dans ta fonction, que la première...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ExtractEMAIL = allMatches(0)

Essaye ceci, ça te renverra la seconde :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ExtractEMAIL = allMatches(1)

Etc...

Il te faut donc une fonction qui te renvoie toutes les valeurs, sous la forme d'un tableau.

Je te propose donc une modification de ta fonction typée "tableau de String" ET avec toutes les variables correctement déclarées (cela oblige à cocher la référence à Microsoft VBScript Regular Expressions) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Option Explicit
 
Function ExtractEMAIL(cel As Range) As String()
'Nécessite de cocher la référence : Microsoft VBScript Regular Expressions X.X
    'sous l'éditeur VBA : Outils/Références...
Dim RegEx As VBScript_RegExp_55.regexp
Dim allMatches  As VBScript_RegExp_55.MatchCollection
Dim Item  As VBScript_RegExp_55.Match
Dim MyRegExPattern As String
Dim temp() As String, i As Integer
 
    MyRegExPattern = "[_a-z0-9-]+(.[a-z0-9-]+)@[a-z0-9-]+(.[a-z0-9-]+)*(.[a-z]{2,4})"
    Set RegEx = New VBScript_RegExp_55.regexp
    With RegEx
        .Global = True
        .IgnoreCase = True
        .Pattern = MyRegExPattern
    End With
    Set allMatches = RegEx.Execute(cel.Value)
    ReDim temp(allMatches.Count)
    For Each Item In allMatches
        temp(i) = Item
        i = i + 1
    Next
    ExtractEMAIL = temp
End Function

Un exemple d'appel :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Sub test()
Dim Adresses() As String
    Adresses = ExtractEMAIL(Range("A1"))
    MsgBox Join(Adresses, vbCrLf)
End Sub

EDIT :Je rejoins Eric sur le fait que si, dans ta cellule, tu n'as QUE des adresses mails, séparées par un séparateur quelconque (espace, point-virgule, etc...), le plus simple est d'utiliser Split.
S'il y a autre chose dans cette cellule, par contre, cette méthode fonctionne. Pas forcément la plus rapide, mais ça fonctionne...

[Fdc_53]

Bonjour,

merci pour vos retours et votre temps,

Effectivement il y a d'autres données dans mes cellules que les adresses mails.

J'ai essayé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ExtractEMAIL = allMatches(1)

qui fonctionne mais annule la bonne extraction

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ExtractEMAIL = allMatches(0)

J'ai aussi essayé ta proposition mais cela me donne le même problème la première adresse mail n'est pas extraite seule.

fichier test en PJ, merci de vos lumières.

[pijaku]

Le pattern que tu as mis n'est pas bon.
Change pour celui-ci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

"[A-Za-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*@(?:[a-z0-9](?:[a-zA-Z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?"

(il en existe certainement d'autres, mais je t'ai mis le premier trouvé qui semble fonctionner)...
trouvé ici :
https://stackoverflow.com/questions/...-extract-email

Code de la fonction :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Function ExtractEMAIL3(cel As Range) As String()
'Nécessite de cocher la référence : Microsoft VBScript Regular Expressions X.X
    'sous l'éditeur VBA : Outils/Références...
Dim RegEx As VBScript_RegExp_55.regexp
Dim allMatches  As VBScript_RegExp_55.MatchCollection
Dim Item  As VBScript_RegExp_55.Match
Dim MyRegExPattern As String
Dim temp() As String, i As Integer
 
    MyRegExPattern = "[A-Za-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*@(?:[a-z0-9](?:[a-zA-Z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?"
    Set RegEx = New VBScript_RegExp_55.regexp
    With RegEx
        .Global = True
        .IgnoreCase = True
        .Pattern = MyRegExPattern
    End With
    Set allMatches = RegEx.Execute(cel.Value)
    ReDim temp(allMatches.Count)
    For Each Item In allMatches
        temp(i) = Item
        i = i + 1
    Next
    ExtractEMAIL3 = temp
End Function

[Fdc_53]

Super, merci cela fonctionne a Merveille!!

[Invité]

Sinon, en splitant :

Nb : Quelle est la probabilité d'avoir deux @ dans la même adresse ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
 
Function SplitAdresse(ByVal Chaine As String) As String
 
Dim I As Integer
Dim MonTableau As Variant
 
    SplitAdresse = ""
    MonTableau = Split(Chaine, " ")
    For I = LBound(MonTableau) To UBound(MonTableau)
        If InStr(1, MonTableau(I), "@", vbTextCompare) > 0 Then
           If Mid(MonTableau(I), 1, 1) = "@" Then
              SplitAdresse = SplitAdresse & Mid(MonTableau(I), 2) & ";"
           Else
              SplitAdresse = SplitAdresse & MonTableau(I) & ";"
           End If
        End If
    Next I
    SplitAdresse = Mid(SplitAdresse, 1, Len(SplitAdresse) - 1)
 
End Function

[pijaku]

Sinon, en splitant :

Nb : Quelle est la probabilité d'avoir deux @ dans la même adresse ?

Aucune.
Par contre, il existe une possibilité que le @ soit dans un des mots qui encombrent la cellule.

Du genre :

@Mot f.canard@gmail.com présent

Mais si ce ne peux pas être le cas, ta solution est bien meilleure...