Private Sub RECUPMAIL()
Set OLapp = CreateObject("Outlook.application" )
Set OLspace = OLapp.GetNamespace("MAPI" )
Set OLinbox = OLspace.GetDefaultFolder(olFolderInbox)
For Each OLmail In OLinbox.Items
If OLmail.SenderName = "NomExpediteur, Prénom" Then
Dim OLbody As String
OLbody = OLmail.Body
Dim xlApp As Excel.Application
Dim wbk As Excel.Workbook
Dim sht As Excel.Worksheet
Set xlApp = CreateObject("Excel.Application" )
With xlApp
.Visible = True
Set wbk = .Workbooks.Add
Set sht = wbk.ActiveSheet
With sht
.Range("A1" ) = OLbody
End With
wbk.SaveAs "C:\Chemin\Dossier\Fichier.xls"
wbk.Close
.Quit
End With
Set sht = Nothing
Set wbk = Nothing
Set xlApp = Nothing
End If
Next
End Sub