Public Sub ListeEmailsNonLus3()
'Code de Staple1600
'http://www.excel-downloads.com/forum/211935-excel-outlook-boucle-if-folder-items-restrict-unread-true-count-0-then.html
'inspiré d'un code de : Timothy Chen Allen
On Error GoTo e_Rr:
Dim ns As Outlook.Namespace, folder As MAPIFolder
Dim item As Object, msg As MailItem, i&, Ws As Worksheet
Set ns = Session.Application.GetNamespace("MAPI")
Set folder = ns.GetDefaultFolder(olFolderInbox)
Set Ws = Worksheets("EMAILS")
With Ws
i = .Cells(Rows.Count, 3).End(xlUp)(2).Row
For Each item In folder.Items
DoEvents
If (item.Class = olMail) And (item.UnRead) Then
Set msg = item
.Cells(i, "A") = msg.ReceivedTime: .Cells(i, "B") = msg.SenderEmailAddress
.Cells(i, "C") = msg.SenderName: .Cells(i, "D") = msg.Subject
i = i + 1
End If
Next
Exit Sub
.Columns("A:H").Columns.AutoFit
End With
e_Rr:
MsgBox Err.Description, vbCritical, Err.Number
End Sub