récupération pièces jointes dans Outlook

[zephir94]

Bonjour à tous,

Je suis entrain d'essayer depuis Excel de récupérer la liste de mail depuis outlook que j'affiche dans un Userform et dans une listview, jusque là tout va bien.
Mon problème est que je souhaite aussi récupérer le nom des pièces jointes, c'est là que je rencontre un soucis car il me récupère bien pour la première ligne le nom de la pièce mais pas pour les suivantes !!!

Voici mon code

Dim OLmail 'As Outlook.MailItem
Dim pceJointe As Outlook.Attachment

  Set olApp = CreateObject("Outlook.Application")
  Set olns = olApp.GetNamespace("MAPI")
  Set olxFolder = olns.GetDefaultFolder(6)
On Error Resume Next
Application.ScreenUpdating = False
With ListView1
ImageList1.ListImages.Clear
.Gridlines = True
.MultiSelect = True
    ImageList1.ImageHeight = 20 'Hauteur
    ImageList1.ImageWidth = 20 'Largeur
répertoirePhoto = ThisWorkbook.Path
c = "mail1"
d = "mail2"
e = "mail4"
ImageList1.ListImages.Add , "Img", LoadPicture(répertoirePhoto & "\" & c & ".JPG")
ImageList1.ListImages.Add , "Img2", LoadPicture(répertoirePhoto & "\" & d & ".JPG")
ImageList1.ListImages.Add , "Img4", LoadPicture(répertoirePhoto & "\" & e & ".JPG")
    '-------------------------------------------
    Set ListView1.SmallIcons = ImageList1
    Set ListView1.Icons = ImageList1
    '-------------------------------------------
Set ListView1.ColumnHeaderIcons = ImageList1
ListView1.CheckBoxes = True
With .ColumnHeaders
            .Clear
            .Add , , "", 15
            .Add , , "Sujet", 150 ', , "Img"
            .Add , , "Corps", 100
            .Add , , "Expéditeur", 90
            .Add , , "Date", 60
            .Add , , "Pièces jointes", 90 ', , "Img4"
        End With
End With
n = 1
Cont1 = 0
Cont2 = 0
For Each i In olxFolder.Items
If i.UnRead(n) = True Then
ListView1.ListItems.Add
ListView1.ListItems(n).ListSubItems.Add , , i.Subject, "Img2"
Cont1 = Cont1 + 1
Else
ListView1.ListItems.Add
ListView1.ListItems(n).ListSubItems.Add , , i.Subject, "Img"
Cont2 = Cont2 + 1
End If
ListView1.ListItems(n).ListSubItems.Add , , i.Body
If i.SenderName = "" Then
a = "Inconnu"
Else
a = i.SenderName
End If
ListView1.ListItems(n).ListSubItems.Add , , a
ListView1.ListItems(n).ListSubItems.Add , , i.CreationTime

  Set pceJointe = i.Attachments(n)
If pceJointe = "" Then
b = "Vide"
ListView1.ListItems(n).ListSubItems.Add , , b
Else
b = pceJointe
ListView1.ListItems(n).ListSubItems.Add , , b, "Img4"
End If
  Set pceJointe = Nothing
  Set i.Attachments(n) = Nothing
n = n + 1
Next i
ListView1.View = lvwReport
UserForm1.Label2.Caption = Cont1
UserForm1.Label3.Caption = Cont2
Application.ScreenUpdating = True

Et je vous joint un fichier test.

Merci par avance pour vos aides

 

[zephir94]

Bonjour à tous,

J'ai trouvé voici donc mon nouveau code, j'ai crée une boucle finalement pour rechercher les pièces jointes dans le message

If Not i.Attachments.Count = 0 Then
                For y = 1 To i.Attachments.Count
                     Set pceJointe = i.Attachments(y)
                    Next y
End If
Set pceJointe = i.Attachments(n)
If pceJointe = "" Then
b = "Vide"
ListView1.ListItems(n).ListSubItems.Add , , b
Else
b = pceJointe.Filename
ListView1.ListItems(n).ListSubItems.Add , , pceJointe.Filename, "Img4"
End If

Merci à tous et bonne fin de journée