extraire des adresses email en macro

[cali]

Bonjour à tous !

Je souhaiterais extraire les adresses email de la colonne A qui contient du texte + adresses email.

Y a t'il une formule avec la macro 'SI' pour le faire?

Merci de votre aide !

 

[Creepy]

Bonjour,

Euhhh tu pourrais être un peu plus précis !! ??

Comment sont faites tes données ? est-ce que le mail se trouve toujours au même endroit de lachiane ou non ?

Y'a-t-il des sépareturs.

Je pense qu'un petit exezmple serait le bienvenu !

++

Creepy

 

[cali]

dans ma cellule A1 contiendrait par exemple : 'brzererzee rfdfsdfdq fsdfds 'test@free.fr'

Je voudrais dans ma cellule B1 qu'il affiche uniquement 'test@free.fr'

merci

 

[Creepy]

RE,

Ton adresse est entre deux guillemet ou c'etait pour l'exemple ?

Y'a des espaces systematiquement ou pas ?

Merci

Creepy

 

[cali]

les guillements sont un exemple (donc pas de guillemets) et pas d'espace lorsque c'est une adresse mail mais sinon dans le texte oui.

 

[fifou_istb]

boujour tout le monde

voila un fichier avec un exemple

[file name=mail_20050712155120.zip size=10866]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/mail_20050712155120.zip[/file]

et voici le code VBA

Sub mail()
Dim a, b, c, d, e, f
a = Selection
For i = 1 To Len(Selection)
    b = Mid(a, i, 1)
    If b = '@' Then
        c = i
        GoTo suite1
        Else
    End If
Next
suite1:
For j = c To 1 Step -1
    b = Mid(a, j, 1)
    If b = ' ' Then
        d = j
        GoTo suite2
        Else
    End If
Next
suite2:
For k = c To Len(Selection)
    b = Mid(a, k, 1)
    If b = Chr(32) Then
        e = k
        GoTo suite3
        Else
    End If
Next
suite3:
f = Mid(a, d + 1, e - d - 1)
Range('b2').Value = f
End Sub

voila

 

[cali]

Merci infiniment, ça marche super !
mais comment je fais si j'ai toutes une colonne de mails à extraire car ta macro ne marche que pour une cellule.

Merci

 

[fifou_istb]

voila
un exemple qui le fait sur plusieur ligne ( jusqu'a la dernière remplie)

[file name=mail_20050712170003.zip size=11441]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/mail_20050712170003.zip[/file]

 

[cali]

Merci mille fois Fifou !

A +

 

[myDearFriend!]

Bonsoir Cali, Creepy, Fifou, le Forum.

En complément de la solution de Fifou (qui fonctionne parfaitement), ci-dessous une solution un peu plus courte :

Sub IsoleMail()
Dim TabExpr As Variant
Dim Ligne As Long, Mot As Long
      For Ligne = 1 To Range('A65536').End(xlUp).Row              'Pour chaque ligne
      TabExpr = Split(Cells(Ligne, 1).Value, ' ', -1)                    'Sépare les mots
            For Mot = 1 To UBound(TabExpr, 1)                             'Pour chaque mot
                  If TabExpr(Mot) Like '*@*' Then                          'Si contient @ alors
                        Cells(Ligne, 2).Value = TabExpr(Mot)              'MAJ colonne B
                        Exit For                                                      'Ligne suivante
                  End If
            Next Mot
      Next Ligne
End Sub

Cordialement,

 

[TestSugar1]

Re : Re:extraire des adresses email en macro

Bonsoir Cali, Creepy, Fifou, le Forum.

En complément de la solution de Fifou (qui fonctionne parfaitement), ci-dessous une solution un peu plus courte :

Cordialement,

Bonjour,

Je viens d'essayer d'utiliser la solution de myDearFriend, mais elle ne fonctionne pas chez moi.

J'ai l'erreur "La méthode 'Range' de l'objet '_Global' a échoué'", sur la ligne For Ligne = 1 To Range(A500).End(xlUp).Row

Savez-vous d'où cela peut venir ?

Je n'arrive pas non plus à faire fonctionner la solution de Fifou : là j'ai "Argument ou appel de procédure incorrect" sur la ligne b = Mid(a, k, 1)...

Merci de votre aide.

 

[vbacrumble]

Re : extraire des adresses email en macro

Bonjour

Remplace les ' par des "

Sub IsoleMail()
Dim TabExpr As Variant
Dim Ligne As Long, Mot As Long
      For Ligne = 1 To Range([COLOR="Red"]"[/COLOR]A65536[COLOR="Red"]"[/COLOR]).End(xlUp).Row              'Pour chaque ligne
      TabExpr = Split(Cells(Ligne, 1).Value,[COLOR="Red"]"[/COLOR] [COLOR="Red"]"[/COLOR], -1)                    'Sépare les mots
            For Mot = 1 To UBound(TabExpr, 1)                             'Pour chaque mot
                  If TabExpr(Mot) Like [COLOR="Red"]"[/COLOR]*@*[COLOR="Red"]"[/COLOR] Then                          'Si contient @ alors
                        Cells(Ligne, 2).Value = TabExpr(Mot)              'MAJ colonne B
                        Exit For                                                      'Ligne suivante
                  End If
            Next Mot
      Next Ligne
End Sub

Même changement à faire pour le code de Fifou.

 

[TestSugar1]

Re : extraire des adresses email en macro

Bonjour

Remplace les ' par des "

J'avais bien eu l'idée mais apparemment j'avais dû faire une faute de frappe...

Maintenant, si je lance la macro IsoleMail, je n'arrive pas toujours à avoir exactement le mail dans la colonne B.

Exemples :
1/ Si j'ai déjà un mail correct dans la colonne A, comment puis-je faire pour le récupérer dans la colonne B ? Actuellement, dans ce cas-là, la cellule B reste vide. (Ensuite je pourrai complètement supprimer la colonne A).

2/ Parfois, dans ma colonne B, je retrouve des choses du genre :
TO:<philippe.vadon@domaine.com>

Received
Comment est-ce que je peux arriver à n'avoir que philippe.vadon@domaine.com ?

3/ J'ai aussi des données de ce type :
david.lallouet@domaine.fr
(saut de ligne)
(saut de ligne)

=> Je voudrais juste david.lallouet@domaine.fr.


Merci !

 

[vbacrumble]

Re : extraire des adresses email en macro

Re



La macro fonctionne si tes mails contiennent ses mails du type:

toto tata@domaine.fr

et renvoie tata@domaine.fr en colonne B

 

[TestSugar1]

Re : extraire des adresses email en macro

Re

La macro fonctionne si tes mails contiennent ses mails du type:

toto tata@domaine.fr

et renvoie tata@domaine.fr en colonne B

OK c'est bien ce que je pensais.
Est-ce que c'est possible de l'étoffer pour traiter les cas que j'ai cités au-dessus ? Il faudrait extraire les adresses mails qui sont entre <> et supprimer les sauts de ligne. Si jamais la cellule A1 est déjà une adresse mail correctement formée, il faudrait aussi la garder.

Vous avez une idée pour faire ça ?

J'ai fait des tests avec une formule du style STXT(L(-1)C;TROUVE("<";L(-1)C)+1;9^9) (qui ramène une valeur sur la cellule du dessous, mais je ne sais pas comment le faire en récursif (le bon nombre de fois pour avoir exactement l'adresse mail).