Convert msg files (Outlook Emails) to pdf at specific folder

prati · Feb 5, 2021

Hey,

I'm trying to write a macro that will look at a specific folder C:\Temp and then convert all MSG files (outlook mails) to pdf, keeping the same file names.
I want to clarify the question - i just want to convert the body text (including headers) - no need to convert the attachments at all.

The msg files

The desired results

Since I'm a beginner in VBA, I can't write the code from scratch
Therefore, what I'm actually trying to do is to modify an existing macro that convert docx to pdf, attempting that it will work in the same way with msg files.

I wrote the code below in order to convert msg files located in c:\temp to pdf - but it doesn't work.

VBA Code:

Sub MsgToPdF()

   Application.ScreenUpdating = False
   Application.DisplayAlerts = False

   Dim OpenSourceFolder As Object, OpenTargetFolder As Object
   Dim SelectedOutlookFilesFolder As String, SelectedPdfFilesFolder As String
   Dim InputOutlookFile As String, OutputPdfFile As String

   Dim objOutlookApp As Outlook.Application
   Dim objMyOutlookFile As Word.Document
   Set objOutlookApp = CreateObject("Outlook.Application")

   SelectedOutlookFilesFolder = "C:\Temp"
   SelectedPdfFilesFolder = "C:\Temp"

   'Looping through only msg files in input file folder

   InputOutlookFile = Dir(SelectedOutlookFilesFolder & "\*.msg")

   While InputOutlookFile <> ""

   Set objMyOutlookFile = objOutlookApp.Documents.Open(SelectedOutlookFilesFolder & "\" & InputOutlookFile)
   objOutlookApp.Visible = True

          OutputPdfFile = SelectedPdfFilesFolder & "\" & Replace(objMyOutlookFile.Name, "msg", "pdf")

   objOutlookApp.ActiveDocument.ExportAsFixedFormat OutputFileName:=OutputPdfFile, ExportFormat:=wdExportFormatPDF

   objMyOutlookFile.Close
   InputOutlookFile = Dir
   Wend

   objOutlookApp.Documents.Application.Quit

End Sub

As I said above the code doesn't function at all. It may contain a lot of errors.

Is there a way to save MSG files to pdf files?

Maybe there is no way to write a macro that save outlook msg files as pdf file
Save a message as a file

I thought about another idea to deal with the problem, maybe there is a way to write a macro that convert MSG files located in specific folder c:\temp to Doc/x.

A macro that convert MSG files to Doc/x files will help me as well, since I already have a macro to convert docx to pdf. therefore if i could convert msg to doc/x then I can convert docx files to pdf files.

Obviously, if there is a macro that convert MSG to pdf directly it is the Preferred solution, but the alternative suggestion/idea (convert msg files to docx files) will be perfect as well.

edmitchell · Feb 9, 2021

Hi, here is a suggested routine:-

this will take the MSG files, into Outlook, save as a '.mht' file, open the 'MHT' file in Word, and then save back into PDF.

once all MSG -> MHT -> PDF are done, it will then delete all the MHT files (which are essentially temporary) - in our input folder.

VBA 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"       'Note no trailing '\'!

'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

Hope it does what you need

prati · Feb 10, 2021

Hey,

It is exactly what i need.

Your code work like a charm and converted my files (thousands of msg files) to pdf pefectly. i still have some more formats to convert...

Do you know what changes i should make in the code in order to convert eml to pdf in the same way? i have a lot of eml files as well. i tried just replace msg with eml, not working.

Lastly and much less important what changes i should make in order to convert mht to pdf as well?

I truly appreciate your help.

edmitchell · Feb 11, 2021

Hi, this version can now be used to convert MSG, EML, or MHT files. When it starts it 'just' asks you to enter which of these 3 types are to be converted (a simple "input box" question, so not sophisticated!)

VBA Code:

Sub MSG_to_PDF()
'Version as of 10/02/21 - original from 09/02/21 plus capable of handling EML or MHT directly
Dim objOL As Object, Msg As MailItem, ThisFile As String

On Error GoTo 0

'Set our folder to where the input files are held
inPath = "C:\temp\msg_to_pdf"       'Note no trailing '\'!

'Check which file extension we are converting
'       MSG needs Outlook to Open and File save as
'       MHT can be opened directly by Word
'       EML 'just' need copying to MHT and then opened in Word
Type_of_file = UCase(InputBox("Which extension are we processing? (e.g. MSG or MHT or EML)", "File Type"))

'If not for us then exit
If (Type_of_file = "MSG" Or Type_of_file = "MHT" Or Type_of_file = "EML") Then
Else
    Exit Sub
End If

'Look for relevant message files in our folder
ThisFile = Dir(inPath & "\*." & Type_of_file)
If (ThisFile = "") Then ' no file found so exit
    Exit Sub
End If

'Open up Outlook for our use, but only if we are processing MSG files.
If (Type_of_file = "MSG") Then
    Set objOL = CreateObject("Outlook.Application")
End If

'Open up Word , which will do the actual conversion from MHT (MIME HTML), EML 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 files that need converting ..
Do While ThisFile <> ""
    
    'Sort out file name plus the new extensions
    New_FileName = Left(ThisFile, Len(ThisFile) - 3)
    MHT_File = New_FileName + "mht"
    PDF_FILE = New_FileName + "PDF"
      
    'Open our MSG file
    If (Type_of_file = "MSG") Then
        Set Msg = objOL.Session.OpenSharedItem(inPath & "\" & ThisFile)
    
        'Save our MSG file as 'MHT' format
        Msg.SaveAs inPath + "\" + MHT_File, 10 '10 = olMHTML
        
    ElseIf (Type_of_file = "EML") Then
        FileCopy inPath & "\" & ThisFile, inPath & "\" & MHT_File   'so copy our EML to MHT
    End If
    
    '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
    
    If (Type_of_file <> "MHT") Then
        Kill inPath + "\" + MHT_File
    End If
    
    'get next file...
    ThisFile = Dir()

Loop

Set objOL = Nothing
Set Msg = Nothing
Set wrdApp = Nothing
Set wrdDoc = Nothing

x = MsgBox("Conversion(s) done")

End Sub

prati · Feb 12, 2021

Hey,
This solution is brilliant.
It is almost perfect.
The code did the job converting MSG to pdf and MHT to pdf.
There is one major problem with the EML conversion to pdf - the headers disappeared.
please find the attached picture.

edmitchell · Feb 13, 2021

Ok - tried a variation on the previous VBA, this now uses 'shellexexcute' to Open the EML files directly into Outlook (as it won't open them 'normally'), this does mean that the Outlook Window "pops up" (maximised) in front of Excel, but cannot see a successful way of making Outlook open minimised (so the 'pop up' is small price to be paid when processing EML files).

I've tried the code with test files of EML, MSG, and MHT and it seems to handle them all 'fine'.

VBA Code:

Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As _
String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
 
Dim objOL As Object



Sub MSG_to_PDF()
'Version as of 12/02/21 - now with diffrent approach for EML. Attempt to make outlook window hide behind Excel.....when handling EML's

Dim Msg As MailItem, ThisFile As String, MHT_File As String, PDF_FILE As String

On Error GoTo 0

'Set our folder to where the input files are held
inPath = "C:\temp\msg_to_pdf"       'Note no trailing '\'!

'Check which file extension we are converting
'       MSG needs Outlook to Open and File save as
'       MHT can be opened directly by Word
'       EML need to be forced open in Outllook by using teh ShellExceute command (but Outlook always open's in maximised window :( )

Type_of_file = UCase(InputBox("Which extension are we processing?" + Chr(10) + "(e.g. MSG or MHT or EML)" + Chr(10) + Chr(10) + _
"[make sure you have backup copies of the file(s) to be converted just in case!]", "File Type"))

'If not for us then exit
If (Type_of_file = "MSG" Or Type_of_file = "MHT" Or Type_of_file = "EML") Then
Else
    Exit Sub
End If

'Look for relevant message files in our folder
ThisFile = Dir(inPath & "\*." & Type_of_file)
If (ThisFile = "") Then ' no file found so exit
    Exit Sub
End If

'Open up Outlook for our use, but only if we are processing MSG files.
If (Type_of_file = "MSG") Then
    Set objOL = CreateObject("Outlook.Application")
End If

'Open up Word , which will do the actual conversion from MHT (MIME HTML), EML 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 files that need converting ..
Do While ThisFile <> ""
    
    'Sort out file name plus the new extensions
    New_FileName = Left(ThisFile, Len(ThisFile) - 3)
    MHT_File = inPath + "\" + New_FileName + "mht"
    PDF_FILE = inPath + "\" + New_FileName + "PDF"
      
    'Open our MSG file
    If (Type_of_file = "MSG") Then
        Set Msg = objOL.Session.OpenSharedItem(inPath & "\" & ThisFile)
        'Save our MSG file as 'MHT' format
        Msg.SaveAs MHT_File, 10 '10 = olMHTML
        
    ElseIf (Type_of_file = "EML") Then
        Set objOL = CreateObject("Outlook.Application") ' Open Outlook first (within Sub we then close on Exit, which seems to avoid odd issues with Outlook
        Call EML_to_MHT(inPath + "\" + ThisFile, MHT_File)
        
    End If
    
    'Open the mht-file in Word without Word being visible
    Set wrdDoc = wrdApp.Documents.Open(Filename:=MHT_File, Visible:=False)

    'Save as pdf
    wrdDoc.ExportAsFixedFormat OutputFileName:= _
        PDF_FILE, ExportFormat:= _
        wdExportFormatPDF
    
    'Close our Word DOC(the MHT file)
    wrdDoc.Close
    
    If (Type_of_file <> "MHT") Then
        Kill MHT_File
    End If
    
    'get next file...
    ThisFile = Dir()

Loop

Set objOL = Nothing
Set Msg = Nothing
Set wrdApp = Nothing
Set wrdDoc = Nothing

x = MsgBox("Conversion(s) done")

End Sub



Sub EML_to_MHT(FN_EML As String, FN_MHT As String)
Dim MyInspect As Object, MyItem As Object

ShellExecute 0, "Open", FN_EML, "", "", 6
   
'attempt to hide the Outlook window which opens maximised (just for Aesthetics!)
Application.WindowState = xlMaximized 'maximize Excel
ActiveWindow.WindowState = xlMaximized 'maximize the workbook in Excel
    
'Wait a bit - hopefully Outlook will then be ready!
Application.Wait (Now + TimeValue("0:00:01"))

Application.WindowState = xlMaximized 'maximize Excel
ActiveWindow.WindowState = xlMaximized 'maximize the workbook in Excel
    
Set MyInspect = objOL.ActiveInspector
Set MyItem = MyInspect.CurrentItem

MyItem.SaveAs FN_MHT, 10 'save as MHT format as above...

MyItem.Close 1

Set MyInspect = Nothing
Set MyItem = Nothing
Set objOL = Nothing

End Sub

prati · Feb 14, 2021

Splendid work.
Better than i imagined.

Mano130898 · Apr 22, 2021

Dear Edmitchel,

You are doing great job. The above code provided for converting MSG to PDF worked well but can you please help in modifying code so that all MSGs in sub folders along with main folder also gets converted to PDF in one go?

VBA Code:

Sub MSG_to_PDF()
'Version as of 10/02/21 - original from 09/02/21 plus capable of handling EML or MHT directly
Dim objOL As Object, Msg As MailItem, ThisFile As String

On Error GoTo 0

'Set our folder to where the input files are held
inPath = "C:\temp\msg_to_pdf"       'Note no trailing '\'!

'Check which file extension we are converting
'       MSG needs Outlook to Open and File save as
'       MHT can be opened directly by Word
'       EML 'just' need copying to MHT and then opened in Word
Type_of_file = UCase(InputBox("Which extension are we processing? (e.g. MSG or MHT or EML)", "File Type"))

'If not for us then exit
If (Type_of_file = "MSG" Or Type_of_file = "MHT" Or Type_of_file = "EML") Then
Else
    Exit Sub
End If

'Look for relevant message files in our folder
ThisFile = Dir(inPath & "\*." & Type_of_file)
If (ThisFile = "") Then ' no file found so exit
    Exit Sub
End If

'Open up Outlook for our use, but only if we are processing MSG files.
If (Type_of_file = "MSG") Then
    Set objOL = CreateObject("Outlook.Application")
End If

'Open up Word , which will do the actual conversion from MHT (MIME HTML), EML 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 files that need converting ..
Do While ThisFile <> ""
   
    'Sort out file name plus the new extensions
    New_FileName = Left(ThisFile, Len(ThisFile) - 3)
    MHT_File = New_FileName + "mht"
    PDF_FILE = New_FileName + "PDF"
     
    'Open our MSG file
    If (Type_of_file = "MSG") Then
        Set Msg = objOL.Session.OpenSharedItem(inPath & "\" & ThisFile)
   
        'Save our MSG file as 'MHT' format
        Msg.SaveAs inPath + "\" + MHT_File, 10 '10 = olMHTML
       
    ElseIf (Type_of_file = "EML") Then
        FileCopy inPath & "\" & ThisFile, inPath & "\" & MHT_File   'so copy our EML to MHT
    End If
   
    '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
   
    If (Type_of_file <> "MHT") Then
        Kill inPath + "\" + MHT_File
    End If
   
    'get next file...
    ThisFile = Dir()

Loop

Set objOL = Nothing
Set Msg = Nothing
Set wrdApp = Nothing
Set wrdDoc = Nothing

x = MsgBox("Conversion(s) done")

End Sub

jamesmartin001 · Aug 27, 2021

This one works from an opened Email, without saving *.msg to a folder it is from this location:

Save Messages as .DOC or .DOCX File Type

How to use VBA to save messages to your hard drive in *.doc format in seconds.

www.slipstick.com

For me it sometimes fails due to a temp folder but I am not sure why.
There is instructions to amend to save to docx but I have not got this to work yet. docx may be more useful as clients increasingly are sending evidence via phones and tablets and the images are embedded now (jpg) and not listed as attachments so for these emails easy to condense the data in one file with the header and body of the email and possibly roatate images if needed. We get erratic evidence provided in terms of attachments so it is difficult to find an automated solution that works for all eventualities. Saving emails as text files is also possible at the location via another VBA, which lists the header with attachments and the email body, and then you can decide what to do with the attachments. [there is a VBA for just saving the attachments which I have not fully tested at this location Useful Microsoft Word macros to remove bookmarks and hyperlinks | Jonathan Mesiano-Crookston, lawyer ]

Sub SaveMessageAsPDF()

Dim Selection As Selection
Dim obj As Object
Dim Item As MailItem

Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Set wrdApp = CreateObject("Word.Application")
Set Selection = Application.ActiveExplorer.Selection

For Each obj In Selection

Set Item = obj

Dim FSO As Object, TmpFolder As Object
Dim sName As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set tmpFileName = FSO.GetSpecialFolder(2)

sName = Item.Subject
ReplaceCharsForFileName sName, "-"
tmpFileName = tmpFileName & "\" & sName & ".mht"

Item.SaveAs tmpFileName, olMHTML

Set wrdDoc = wrdApp.Documents.Open(FileName:=tmpFileName, Visible:=True)

Dim WshShell As Object
Dim SpecialPath As String
Dim strToSaveAs As String
Set WshShell = CreateObject("WScript.Shell")
MyDocs = WshShell.SpecialFolders(16)

strToSaveAs = MyDocs & "\" & sName & ".pdf"

' check for duplicate filenames
' if matched, add the current time to the file name
If FSO.fileExists(strToSaveAs) Then
sName = sName & Format(Now, "hhmmss")
strToSaveAs = MyDocs & "\" & sName & ".pdf"
End If

wrdApp.ActiveDocument.ExportAsFixedFormat OutputFileName:= _
strToSaveAs, ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, From:=0, To:=0, Item:= _
wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False

Next obj
wrdDoc.Close
wrdApp.Quit
Set wrdDoc = Nothing
Set wrdApp = Nothing
Set WshShell = Nothing
Set obj = Nothing
Set Selection = Nothing
Set Item = Nothing

End Sub

' This function removes invalid and other characters from file names
Private Sub ReplaceCharsForFileName(sName As String, sChr As String)
sName = Replace(sName, "/", sChr)
sName = Replace(sName, "\", sChr)
sName = Replace(sName, ":", sChr)
sName = Replace(sName, "?", sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "<", sChr)
sName = Replace(sName, ">", sChr)
sName = Replace(sName, "|", sChr)
sName = Replace(sName, "&", sChr)
sName = Replace(sName, "%", sChr)
sName = Replace(sName, "*", sChr)
sName = Replace(sName, " ", sChr)
sName = Replace(sName, "{", sChr)
sName = Replace(sName, "[", sChr)
sName = Replace(sName, "]", sChr)
sName = Replace(sName, "}", sChr)
sName = Replace(sName, "!", sChr)
End Sub

Convert msg files (Outlook Emails) to pdf at specific folder

prati

Board Regular

Attachments

Excel Facts

edmitchell

Board Regular

prati

Board Regular

edmitchell

Board Regular

prati

Board Regular

Attachments

edmitchell

Board Regular

prati

Board Regular

Mano130898

New Member

jamesmartin001

New Member

Save Messages as .DOC or .DOCX File Type

Similar threads

Forum statistics

Share this page

Convert msg files (Outlook Emails) to pdf at specific folder

Board Regular

Attachments

Excel Facts

Board Regular

Board Regular

Board Regular

Board Regular

Attachments

Board Regular

Board Regular

New Member

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock