Hi Team,
Greetings!
I am using the below code to save outlook emails as PDF's, however could not covert properly the emails which as tables and images in the body of the email. The data is cropped and full message which is in body of the email is not captured in PDF.
Request you to please assist.
Code
Sub MSG_to_PDF()
Dim objOL As Object, Msg As MailItem, ThisFile As String
On Error GoTo 0
'Set our folder to where the 'MSG' files are held
InPath = "C:\temp\msg_to_pdf"
'Look for *.msg files in our folder
ThisFile = Dir(InPath & "\*.msg")
If (ThisFile = "") Then ' no file found so exit
Exit Sub
End If
'Open up Outlook for our use
Set objOL = CreateObject("Outlook.Application")
'Open up Word , which will do the actual conversion from MHT (MIME HTML) to PDF
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Set wrdApp = CreateObject("Word.Application")
'wrdapp.visible (uncomment to see the Word instance!)
'Loop through our MSG files..
Do While ThisFile <> ""
'Open our MSG file
Set Msg = objOL.Session.OpenSharedItem(InPath & "\" & ThisFile)
'Sort oout file name plus the new extensions
New_FileName = Left(ThisFile, Len(ThisFile) - 3)
Mht_File = New_FileName + "mht"
PDF_FILE = New_FileName + "PDF"
'Save our MSG file as 'MHT' format
Msg.SaveAs InPath + "\" + Mht_File, 10 '10 = olMHTML
'Open the mht file in Word without Word being visible
Set wrdDoc = wrdApp.Documents.Open(Filename:=InPath + "\" + Mht_File, Visible:=False)
'Save as pdf
wrdDoc.ExportAsFixedFormat OutputFileName:= _
InPath + "\" + PDF_FILE, ExportFormat:= _
wdExportFormatPDF
'Close our Word DOC(the MHT file)
wrdDoc.Close
'get next file...
ThisFile = Dir()
Loop
Set objOL = Nothing
Set Msg = Nothing
Set wrdApp = Nothing
Set wrdDoc = Nothing
'Remove the MHT temporary files..- did try immediately after Word closes the MHT file, but would have to create time/pause, as Word takes a while...
Kill InPath + "\*.MHT"
x = MsgBox("Conversion(s) done")
End Sub