Sub BBG()
Dim MonApp As Outlook.Application
Dim MonNameSpace As Outlook.Namespace
Dim MonDossier As Outlook.Folder
Dim MonMail As Outlook.MailItem
Dim numero As Integer
Dim strAttachment As String
Dim NbAttachments As Integer
Dim chemin As String
Dim Ligne As Long
Dim J As Long
Dim datejour As Date: datejour = Date
'Instance des objets
Set MonApp = Outlook.Application
Set MonNameSpace = MonApp.GetNamespace("MAPI")
Set MonDossier = MonNameSpace.GetDefaultFolder(olFolderInbox)
Set myNewFolder = MonDossier.Folders("Bloomberg")
numero = myNewFolder.Items.Count
For i = 1 To numero
Set MonMail = myNewFolder.Items(numero - i)
Ligne = Ligne + 2
For J = 1 To Len(MonMail.Body) Step 1024
Ligne = Ligne + 1
Cells(Ligne, I) = Mid(MonMail.Body, J, 1024)
Next J
Next i
End Sub