Discussion :

[Simbaa]

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 :

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
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 !

Merci d'avance !

[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 :

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

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

[Simbaa]

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 :

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