Récupérer une adresse mail dans le corps d'un mail outlook

Bonjour à tous,

Ceci étant mon premier post et n'étant pas développeur (je suis juste un manager geek, bidouilleur d'excel ) veuillez m'excuser si ma question vous parait bête ou le code bidouillé complètement erroné.

Voici le contexte de ma demande dans le cadre de mon boulot :

Nous recevons des mails provenant de formulaires web avec comme expéditeur toujours la même adresse

Ces mails sont toujours construit comme tel :

Bonjour ,

BLA BLA BLA.

Vous trouverez ci-dessous les éléments nécessaires à la prise en compte de sa demande :

Origine de la souscription : xxx

Civilité : xxx

Nom : xxx

Prénom : xxx

Tél : xxx

Email : xxx

Adresse : xxx

Code Postal : xxx

Ville : xxx

Rappel du motif : xxx

Commentaire : xxx

Nous vous remercions de prendre en compte sa demande dans les meilleurs délais.

Cordialement,

Je souhaiterais récupérer l'adresse mail contenu dans le champ "Email :" pour ensuite faire tourner une autre macro d'envoi de mail normé à la liste d'adresses mails extraites.

J'avais trouvé des réponses ici :https://forum.excel-pratique.com/viewtopic.php?t=30977

Mais je n'arrive pas à récupérer ce que je veux.

Je vous mets le code récupéré et bidouillé mais qui ne me donne rien (pas d'erreur de compilation ni d’exécution mais il ne se passe rien lorsque je lance ma macro)

Pourriez-vous m'aider à extraire cette donnée svp ?

Bonjour,

Attention, vous utilisez de nombreuses variables qui ne sont pas déclarées, certaines n'ont pas ailleurs aucune valeur affectée (Titre ou Auteur par exemple). D'autres variables sont également inutilisée après affectation d'une valeur (DateT, fromsender, etc).

Ceci n'empêche à priori pas le fonctionnement de la macro, mais charge inutilement le code et est source d'erreur.

En revanche, la variable TEST censée contenir le nom ou la position de la feuille de destination n'est pas affectée. Si la feuille s'appelle TEST, il faut encadrer son nom par des guillemets.

Je ne m'y connais absolument pas concernant l'envoi et/ou le traitement de mails, mais j'ai essayé de modifier votre code par rapport aux remarques précédentes. A tester :

Sub LireMessages()

Dim olapp As Outlook.Application
Dim NS As Object, Dossier As Object
Dim OlExp As Object, Mail As Object
Dim mybody() As String
Dim Obj As OLEObject
Dim Ligne As Long, Compt As Integer
Set olapp = CreateObject("Outlook.Application")
Set NS = olapp.GetNamespace("MAPI")
Set Dossier = NS.Folders("xxx@xx.com").Folders("Boîte de réception")

With Sheets("TEST")
    For Each Mail In Dossier.Items
        Ligne = .[A65000].End(xlUp).Row + 1
        If Mail.UnRead = True Then
            If Mail.SenderEmailAddress = "noreply@xxx.fr" Then
                mybody = Split(UCase(Mail.Body), vbCrLf)
                .Cells(Ligne, 1) = Mail.Subject 'Sujet
                .Cells(Ligne, 2) = Mail.CreationTime 'Date mail
                For Compt = 0 To UBound(mybody)
                    Select Case True
                        Case mybody(Compt) Like UCase("*Origine de la souscription :*")
                            .Cells(Ligne, 3) = LTrim(Split(mybody(Compt), ":")(1)) 'Réseau
                        Case mybody(Compt) Like UCase("*Nom :*")
                            .Cells(Ligne, 4) = LTrim(Split(mybody(Compt), ":")(1)) 'Nom
                        Case mybody(Compt) Like UCase("*Prénom :*")
                            .Cells(Ligne, 5) = LTrim(Split(mybody(Compt), ":")(1)) 'Prénom
                        Case mybody(Compt) Like UCase("*Civilité :*")
                            .Cells(Ligne, 6) = LTrim(Split(mybody(Compt), ":")(1)) 'Civilité
                        'Titre ?
                        'Auteur ?
                        Case mybody(Compt) Like UCase("*Adresse :*")
                            .Cells(Ligne, 9) = LTrim(Split(mybody(Compt), ":")(1)) 'Adresse
                        Case mybody(Compt) Like UCase("*Code postal :*")
                            .Cells(Ligne, 10) = LTrim(Split(mybody(Compt), ":")(1)) 'CP
                        Case mybody(Compt) Like UCase("*Email :*")
                            .Cells(Ligne, 11) = LTrim(Split(mybody(Compt), ":")(1)) 'Email
                        Case mybody(Compt) Like UCase("*Tél :*")
                            .Cells(Ligne, 12) = LTrim(Split(mybody(Compt), ":")(1)) 'Tél
                        Case mybody(Compt) Like UCase("*Villes :*")
                            .Cells(Ligne, 13) = LTrim(Split(mybody(Compt), ":")(1)) 'Ville
                        Case mybody(Compt) Like UCase("*Rappel du motif :*")
                            .Cells(Ligne, 15) = LTrim(Split(mybody(Compt), ":")(1)) 'Motif
                        Case mybody(Compt) Like UCase("*Commentaire :*")
                            .Cells(Ligne, 16) = LTrim(Split(mybody(Compt), ":")(1)) 'Commentaire
                    End Select
                Next Compt
                .Range(Cells(Ligne, 1), Cells(Ligne, 16)).Borders.Value = 1
                Mail.UnRead = False
             End If
        End If
    Next Mail
End With

Set NS = Nothing
Set Dossier = Nothing
Set Mail = Nothing

End Sub

PS : attention il faut vérifier que le caractère qui précède : est bien un espace classique.

Bonjour,

Merci pour la réponse rapide et la correction.

J'ai intégré le code corrigé mais le résultat est le même je n'ai rien sur ma feuille "TEST" après le lancement de la macro.

Est-ce qu'il y a une manipulation à faire en plus d’exécuter la macro ?

Je vous mets le fichier corrigé pour voir ce qui ne va pas .

Bonjour,

Je n'ai pas la capacité de tester le code, donc je ne saurais vous aider davantage. Avez vous vérifié le caractère précédent ":", comme mentionné dans mon post précédent ?

Question (peut-être très bête) mais comment faire pour vérifier s'il s'agit bien d'un espace classique ?

Benjabell a écrit :

Question (peut-être très bête) mais comment faire pour vérifier s'il s'agit bien d'un espace classique ?

Par exemple, par copié-collé dans une formule =CODE("x"), où x est ton fameux caractère. Si le code obtenu n'est pas le même qu'avec un espace classique, la macro ne trouvera donc jamais de correspondance exacte (et aucune info ne sera donc reportée).

Je pense que l'espace qui précède ":" est un espace insécable (pas de coupure de mot et saut de ligne à cet endroit), correspondant au code 160, à la différence de l'espace classique qui correspond au code 10.

Merci pour le tuyau pour déterminer le type de caractère c'est vraiment pratique.

Bon le retour m'inquiète car c'est un code 32 (d'après ce que j'ai pu trouver sur le net il s'agit bien d'un espace classique).

Est-il possible que le problème soit tout simplement dû au fait que j'ai cet espace avant ET après les ":" ?

Bonjour,

En fait, tout dépend du système mis en place par votre société.

Faites le test ci-dessous pour avoir plus d'infos...

Sub LireMessages()

Dim olapp As Outlook.Application
Dim NS As Object, Dossier As Outlook.Folder
Dim Mail As Outlook.MailItem
Dim i As Integer
   Set olapp = CreateObject("Outlook.Application")
   Set NS = olapp.GetNamespace("MAPI")
   Set Dossier = NS.Folders("xxxx.xxxx@xxxx.fr").Folders("Boîte de réception")

    For i = 1 To 10            'Dossier.Items.Count
        Set Mail = Dossier.Items.Item(i)
            MsgBox "SenderEmailAddress : " & Mail.SenderEmailAddress & vbCrLf & "Sender : " & Mail.Sender & vbCrLf & "SenderName : " & Mail.SenderName
    Next i

Set NS = Nothing
Set Dossier = Nothing
Set Mail = Nothing
Set olapp = Nothing
End Sub

10 MsgBox vont s'afficher avec les propriétés de l'expéditeur du mail.

J'ai intégré le code dans une nouvelle macro et voici les réponses obtenues (les deux mails testés ont donné les mêmes résultats et je n'ai eu que 2 MsgBox je ne sais pas si c'est logique ou non).

Par contre j'ai eu ce message en fin d'éxecution je ne sais pas si c'est normal.

En tout cas déjà un grand merci pour l'aide, c'est TOP

Bonjour,

Pour le message d'erreur, c'est normal.

J'ai forcé la boucle jusqu'à 10...

Il faut que tu conserves ta boucle initiale, à savoir "For Each"...

Ensuite, tu n'as plus qu'à remplacer ta ligne :

If Mail.SenderEmailAddress = "noreply@xxx.fr" Then

Par :

If Mail.Sender = "noreply" Then

ou par :

If Mail.SenderName = "noreply" Then

Ou encore (on ne sait jamais) :

If Trim$(LCase$(Mail.SenderName)) = "noreply" Then

Tu devrais obtenir un résultat.

Un million de merci !!

La première solution est la bonne :

Remplacer

If Mail.SenderEmailAddress = "noreply@..." Then

Par :

If Mail.Sender = "noreply" Then

J'ai bien obtenu les données de chaque catégorie du formulaire dans une colonne distincte c'est exactement ce que je souhaitait.

Encore merci !

Maintenant je n'ai plus qu'à finir de coder une autre macro d'envoi de mail en fonction de l'adresse mail récupéré et le tour et joué !

PS : je mets le fichier final en PJ si besoin.