VBA : Backup Mails Outlook

VBA Sauvegarde des mails individuellement sous forme de fichiers HTML :

VBA : ALT+F11

[pastacode lang= »c » manual= »Sub%20sav_mail_as_msg(Optional%20objCurrentMessage%20As%20Object)%0A’By%20Oliv’%20juillet%202007%20pour%20OUTLOOK%202003%0A%0A%0A%20%20%20%20If%20objCurrentMessage%20Is%20Nothing%20Then%20Set%20objCurrentMessage%20%3D%20ActiveInspector.CurrentItem%0A%20%20%20%20’Set%20objCurrentMessage%20%3D%20ActiveInspector.CurrentItem%0A%0A%20%20%20%20’Ici%20on%20construit%20le%20nom%20du%20fichier%20qui%20sera%20cr%C3%A9%C3%A9%0A%20%20%20%20NomExport%20%3D%20objCurrentMessage.Subject%20%26%20objCurrentMessage.CreationTime%0A%0A%20%20%20%20’Ici%20on%20d%C3%A9fini%20le%20r%C3%A9pertoire%20o%C3%B9%20l’enregistrer%0A%20%20%20%20repertoire%20%3D%20%22c%3A%5Cmail%5C%22%0A%20%20%20%20’repertoire%20%3D%20BrowseForFolder(%22Choisissez%20la%20destination%22%2C%20SDossier(5%2C%200))%20%26%20%22%5C%22%0A%0A%20%20%20%20’Ici%20on%20supprime%20les%20caract%C3%A8res%20non%20autoris%C3%A9%20dans%20les%20noms%20de%20fichiers%0A%20%20%20%20PathNomExport%20%3D%20repertoire%20%26%20%22Email%20%22%20%26%20Left(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(%20_%0A%20%20%20%20NomExport%2C%20%22%5C%22%2C%20%22%22)%2C%20%22%2F%22%2C%20%22%22)%2C%20%22%3A%22%2C%20%22%22)%2C%20%22*%22%2C%20%22%22)%2C%20%22%3F%22%2C%20%22%22)%2C%20%22%3C%22%2C%20%22%22)%2C%20%22%3E%22%2C%20%22%22)%2C%20%22%7C%22%2C%20%22%22)%2C%20%22.%22%2C%20%22%22)%2C%20%22%22%22%22%2C%20%22%22)%2C%20vbTab%2C%20%22%22)%2C%20Chr(7)%2C%20%22%22)%2C%20160)%0A%20%20%20%20%0A%20%20%20%20’PathNomExport%20%3D%20PathNomExport%20%26%20%22.msg%22%0A%20%20%20%20PathNomExport%20%3D%20PathNomExport%20%26%20%22.html%22%0A%20%20%20%20%0A%20%20%20%20’Ici%20on%20v%C3%A9rifie%20que%20le%20fichier%20n’existe%20pas%20d%C3%A9j%C3%A0%20sinon%20il%20serait%20%C3%A9cras%C3%A9%20%3D%3E%20Incr%C3%A9ment%0A%20%20%20%20n%20%3D%201%0A%20%20%20%20MemPath%20%3D%20PathNomExport%0A%20%20%20%20While%20Dir(PathNomExport)%20%3C%3E%20%22%22%0A%20%20%20%20%20%20%20%20MsgBox%20%22Le%20fichier%20%22%20%26%20vbCr%20%26%20PathNomExport%20%26%20vbCr%20%26%20%22existe%20d%C3%A9j%C3%A0%22%2C%20vbInformation%0A%20%20%20%20%20%20%20%20’PathNomExport%20%3D%20Left(MemPath%2C%20Len(MemPath)%20-%204)%20%26%20%22(%22%20%26%20n%20%26%20%22)%22%20%26%20%22.msg%22%0A%20%20%20%20%20%20%20%20PathNomExport%20%3D%20Left(MemPath%2C%20Len(MemPath)%20-%204)%20%26%20%22(%22%20%26%20n%20%26%20%22)%22%20%26%20%22.html%22%0A%20%20%20%20%20%20%20%20n%20%3D%20n%20%2B%201%0A%0A%20%20%20%20Wend%0A%20%20%20%20’objCurrentMessage.SaveAs%20PathNomExport%2C%20OlSaveAsType.olMSG%0A%20%20%20%20objCurrentMessage.SaveAs%20PathNomExport%2C%20OlSaveAsType.olHTML%0A%20%20%20%20%0A%20%20%20%20%0A%20%20%20%20’olTXT%20Text%20format%20(.txt)%0A%20%20%20%20’olRTF%20Rich%20Text%20format%20(.rtf)%0A%20%20%20%20’olMSG%20Outlook%20message%20format%20(.msg)%0A%20%20%20%20’olDoc%20Microsoft%20Office%20Word%20format%20(.doc)%0A%20%20%20%20’olHTML%20HTML%20format%20(.html)%0A%0A%0AEnd%20Sub%0A%0ASub%20LanceSurOuvert()%0A%20%20%20%20sav_mail_as_msg%0AEnd%20Sub%0A%0A%0ASub%20LanceSurSelection()%0A%20%20%20%20Dim%20MonOutlook%20As%20Outlook.Application%0A%20%20%20%20Dim%20LeMail%20As%20Object%0A%20%20%20%20Dim%20LesMails%20As%20Outlook.Selection%0A%20%20%20%20Set%20MonOutlook%20%3D%20Outlook.Application%0A%0A%20%20%20%20Set%20LesMails%20%3D%20MonOutlook.ActiveExplorer.Selection%0A%0A%20%20%20%20For%20Each%20LeMail%20In%20LesMails%0A%20%20%20%20%20%20%20%20sav_mail_as_msg%20LeMail%0A%20%20%20%20Next%20LeMail%0A%0A%20%20%20%20Set%20LesMails%20%3D%20Nothing%0A%20%20%20%20MsgBox%20%22Fin%20de%20traitement%22%0AEnd%20Sub%0A%0A » message= »Copie (Explode) Contenu Mail sur DD  » highlight= » » provider= »manual »/]