Public Sub ExportMSGasPdf()
With Application.FileDialog(msoFileDialogFilePicker)
.Filters.Clear
.Filters.Add "To do", "*.msg"
.InitialFileName = ThisWorkbook.Path & "\"
.AllowMultiSelect = True
.Title = "Sélectionner les Msg à exporter"
If .Show Then
For Each file In .SelectedItems
Do_Export file
Next
End If
End With
End Sub
Sub Do_Export(Msg)
Dim ObjOutlook As Object
Const wdExportFormatPDF = 17
On Error Resume Next
Set ObjOutlook = CreateObject("Outlook.Application")
If ObjOutlook Is Nothing Then Set ObjOutlook = GetObject(, "Outlook.Application")
On Error GoTo 0
With ObjOutlook.GetNamespace("MAPI").OpenSharedItem(Msg)
.Display
Msg = Left(Msg, Len(Msg) - Len("msg")) & "pdf"
.GetInspector.WordEditor.ExportAsFixedFormat Msg, wdExportFormatPDF ', True
.Close olDiscard
End With
On Error Resume Next
Set ObjOutlook = Nothing
End Sub