Sub LitMessagerie()
Set olApp = CreateObject("Outlook.Application")
Set olns = olApp.GetNamespace("MAPI")
Set olxFolder = olns.GetDefaultFolder(6) ' olns.GetDefaultFolder(olFolderInbox)
Sheets("Litmessagerie").Select
Set myDestFolderADM = olns.GetDefaultFolder(6).Folders("3- TRAITER")
On Error Resume Next
n = 2
For Each i In myDestFolderADM.Items 'olxFolder.Items
Cells(n, 1) = i.Subject
MonBody = i.Body
Crea = Mid(MonBody, InStr( MonBody, " Creati-Fiche-Central (ENTREPRISE SA)") ,- 20)
Cells(n, 4) = Crea
Next
End Sub