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