Sub sav_mail_as_msg(Optional objCurrentMessage As Object)
'By Oliv' juillet 2007 pour OUTLOOK 2003


    If objCurrentMessage Is Nothing Then Set objCurrentMessage = ActiveInspector.CurrentItem
    'Set objCurrentMessage = ActiveInspector.CurrentItem

    'Ici on construit le nom du fichier qui sera créé
    NomExport = objCurrentMessage.Subject & objCurrentMessage.CreationTime

    'Ici on défini le répertoire où l'enregistrer
    repertoire = "c:\mail\"
    'repertoire = BrowseForFolder("Choisissez la destination", SDossier(5, 0)) & "\"

    'Ici on supprime les caractères non autorisé dans les noms de fichiers
    PathNomExport = repertoire & "Email " & Left(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
    NomExport, "\", ""), "/", ""), ":", ""), "*", ""), "?", ""), "<", ""), ">", ""), "|", ""), ".", ""), """", ""), vbTab, ""), Chr(7), ""), 160)
    
    'PathNomExport = PathNomExport & ".msg"
    PathNomExport = PathNomExport & ".html"
    
    'Ici on vérifie que le fichier n'existe pas déjà sinon il serait écrasé => Incrément
    n = 1
    MemPath = PathNomExport
    While Dir(PathNomExport) <> ""
        MsgBox "Le fichier " & vbCr & PathNomExport & vbCr & "existe déjà", vbInformation
        'PathNomExport = Left(MemPath, Len(MemPath) - 4) & "(" & n & ")" & ".msg"
        PathNomExport = Left(MemPath, Len(MemPath) - 4) & "(" & n & ")" & ".html"
        n = n + 1

    Wend
    'objCurrentMessage.SaveAs PathNomExport, OlSaveAsType.olMSG
    objCurrentMessage.SaveAs PathNomExport, OlSaveAsType.olHTML
    
    
    'olTXT Text format (.txt)
    'olRTF Rich Text format (.rtf)
    'olMSG Outlook message format (.msg)
    'olDoc Microsoft Office Word format (.doc)
    'olHTML HTML format (.html)


End Sub

Sub LanceSurOuvert()
    sav_mail_as_msg
End Sub


Sub LanceSurSelection()
    Dim MonOutlook As Outlook.Application
    Dim LeMail As Object
    Dim LesMails As Outlook.Selection
    Set MonOutlook = Outlook.Application

    Set LesMails = MonOutlook.ActiveExplorer.Selection

    For Each LeMail In LesMails
        sav_mail_as_msg LeMail
    Next LeMail

    Set LesMails = Nothing
    MsgBox "Fin de traitement"
End Sub