Récupérer une image dans le corps d'un mail depuis Excel

Version imprimable

Bonjour,

J'ai besoin de récupérer une image contenue dans un mail, et l'ajouter à une présentation Powerpoint créée dans le même programme VBA.
Je pense le faire en 2 étapes : récupérer le corps du mail sur un nouveau classeur, puis exporter l'image voulue dans la présentation powerpoint.

Mais j'ai du mal avec la première étape...
Je recherche le mail dans la boîte de réception en fonction de l'objet (Subject) mais la boucle For each qui parcourt les mails pose problème, il y a une erreur "Incompatibilité de type" au niveau du Next. Je ne comprends pas l'erreur... Si je relance directement le programme sans "réinitialiser", il fonctionne, le contenu du mail s'importe comme prévu dans le programme en "A1", cependant comme OLmail est déclarée "String" les images contenu dans le corps du mail arrivent sur le classeur Excel en : cid:image.png (en plus du texte).

Le contenu texte du mail m'importe peu, donc je ne sais pas trop comment déclarée la variable pour que le programme me renvoie les images.
Code:

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 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 Dim OLapp As Outlook.Application Dim OLspace As Outlook.Namespace Dim OLinbox As Outlook.MAPIFolder Dim OLfolder As Outlook.MAPIFolder Dim OLmail As Outlook.MailItem Dim OLpj As Outlook.Attachment Private Sub chMail() Set OLapp = CreateObject("Outlook.application") Set OLspace = OLapp.GetNamespace("MAPI") Set OLinbox = OLspace.GetDefaultFolder(olFolderInbox) For Each OLmail In OLinbox.Items If OLmail.Subject = "Objet_du_mail" Then Dim OLbody As String OLbody = OLmail.Body Dim xlApp As Excel.Application Dim wbk As Excel.Workbook Dim sht As Excel.Worksheet Set xlApp = CreateObject("Excel.Application") With xlApp .Visible = True Set wbk = .Workbooks.Add Set sht = wbk.ActiveSheet With sht .Range("A1") = OLbody End With End With End If Next OLmail End Sub
Si quelqu'un a déja fait ça ou peut m'aider, n'hésitez pas ! :lol:

Merci d'avance !

24/11/2016, 12h11
joe.levrai
Bonjour,

il faut parcourir la collection des Attachments qui contient ces images.

Je ne sais pas si tu connais le nom de l'image, ou tout du moins son extension... pour trouver la bonne image

voici déjà pour lister toutes les PJ et images d'un mail ... celui qui est actuellement sélectionné dans ton explorateur
Code:

1 2 3 4 5 6 Dim PJ As Attachment With ActiveExplorer.Selection.Item(1) For Each PJ In .Attachments MsgBox PJ.DisplayName Next PJ End With
Avec ça, il ne te reste qu'à affiner la détection de la bonne image

Merci à toi pour ta réponse mais je n'y arrive toujours pas ...

Oui j'ai le nom de l'image mais l'image arrive sous Excel juste sous forme texte (image002.png), est ce un problème de déclaration de variable ?

Mon problème d'incompatibilité de type au niveau du dernier "Next" persiste mais fonctionne tout de même après un 2e lancement du programme sans réinitialisation...

Code:

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
 
 Dim OLapp As Outlook.Application
 Dim OLspace As Outlook.Namespace
 Dim OLinbox As Outlook.MAPIFolder
 Dim OLfolder As Outlook.MAPIFolder
 Dim OLmail As Outlook.MailItem
 Dim OLpj As Outlook.Attachment
 
 Private Sub chMail()
 
     Set OLapp = CreateObject("Outlook.application")
     Set OLspace = OLapp.GetNamespace("MAPI")
     Set OLinbox = OLspace.GetDefaultFolder(olFolderInbox)
 
     For Each OLmail In OLinbox.Items
         If OLmail.Subject = "Pilotage - Octroi du mercredi 16 novembre 2016 - Point de 17h00" Then
 
             With ActiveExplorer.Selection.Item(1)
                 For Each OLpj In .Attachments
                     If OLpj.DisplayName = "image002.png" Then
                         Dim xlApp As Excel.Application
                         Dim wbk As Excel.Workbook
                         Dim sht As Excel.Worksheet
 
                         Set xlApp = CreateObject("Excel.Application")
                         With xlApp
                              .Visible = True
                             Set wbk = .Workbooks.Add
                             Set sht = wbk.ActiveSheet
 
                             With sht
                                  .Range("A1") = OLpj
                             End With
                         End With
                    End If
                Next OLpj
            End With
        End If
     Next OLmail
 
 End Sub