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 42 43 44 45 46 47 48 49 50 51
| Sub test()
Set olApp = CreateObject("Outlook.Application")
Set olns = olApp.GetNamespace("MAPI")
Set olxFolder = olns.GetDefaultFolder(6)
On Error Resume Next
With ListView1
ImageList1.ListImages.Clear
ImageList1.ImageHeight = 16 'Hauteur
ImageList1.ImageWidth = 16 'Largeur
rep = ThisWorkbook.Path
c = "mail1"
ImageList1.ListImages.Add , "Img", LoadPicture(rep & "\" & c & ".JPG")
Set ListView1.SmallIcons = ImageList1
Set ListView1.Icons = ImageList1
ListView1.CheckBoxes = True
With .ColumnHeaders
.Clear
.Add , , "Sujet", 150
.Add , , "Corps", 100
.Add , , "Expéditeur", 90
.Add , , "Date", 60
.Add , , "Fichier", 90
End With
End With
n = 1
For Each i In olxFolder.Items
ListView1.ListItems.Add , , i.Subject, "Img"
ListView1.ListItems(n).ListSubItems.Add , , i.Body
If i.SenderName = "" Then
a = "xxx@xxx.fr"
Else
a = i.SenderName
End If
ListView1.ListItems(n).ListSubItems.Add , , a
ListView1.ListItems(n).ListSubItems.Add , , i.CreationTime
'ListView1.ListItems(n).ListSubItems.Add , , i.attachement
n = n + 1
Next i
ListView1.View = lvwReport
End Sub |
Partager