vba outlook:Sauvegarder automatiquement les mails

Astuce N° 1 , niveau amateur éclairé ^^
Sauvegarder automatiquement les mails recus d'une personne dans un fichier texte avec le "mail_" + le sujet du message en nom de fichier texte :
Dim OLapp As Outlook.Application
Dim OLspace As Outlook.NameSpace
Dim OLinbox As Outlook.MAPIFolder
Dim OLfolder As Outlook.MAPIFolder
Dim OLmail As Outlook.MailItem
Dim OLpj As Outlook.Attachment
Private Sub TransfertMailsDansFichierTexte()
Dim OLbody As String
Dim Cible As Integer
Dim i As Byte
Set OLapp = CreateObject("Outlook.application")
Set OLspace = OLapp.GetNamespace("MAPI")
Set OLinbox = OLspace.GetDefaultFolder(olFolderInbox)
For Each OLmail In OLinbox.Items
If OLmail.SenderName = "Person Roseline" Then
OLbody = OLmail.Body
i = i + 1
Cible = FreeFile
nom = OLmail.Subject
'Adapter chemin fichier de suivi sur le reseau
Open "C:\TST\mail_" & nom & ".txt" For Append As #Cible
Print #1, OLbody
Close #Cible
End If
Next
Set OLapp = Nothing
Set OLspace = Nothing
Set OLinbox = Nothing
End Sub
Private Sub Application_NewMail()
Call TransfertMailsDansFichierTexte
End Sub