Printing an Emails each on a seperate page from an email train

dwe0608 used Ask the Experts™
Hi Guys,
I need a work around to print email trains, but keep each email on a separate page - printing to PDF being a preference. At the moment, we select a message, copy and paste the first message in the email train to MSWord, save it to PDF using the year month day time as the file name, and then print ... then move to the second message in the email train and so forth ...

Now when I look at an email in the web browser (we use Office365) each message is contracted except the one we're looking at - and it is possible to do what I need to from the web browser using an addin called K-Print ... it only prints the message selected.... but I'm a little apprehensive about the security issue because we're part of a law firm ... and the addin seems to convert the email in the Cloud as opposed to on the local machine ...

I found a snippet of code in VBA which will print the email train in total to PDF ...

I'd be interested if someone knows how to seperate out each email and place it on a seperate page ....

Sub SaveAsPDFfile()

' Description: Outlook macro to save a selected item in the pdf-format
' Requires Word 2007 SP2 or Word 2010
' Requires a reference to "Microsoft Word <version> Object Library"
' (version is 12.0 or 14.0)
' In VBA Editor; Tools-> References...
' author: Robert Sparnaaij
' website:

    'Get all selected items
    Dim MyOlNamespace As Outlook.NameSpace
    Set MyOlNamespace = Application.GetNamespace("MAPI")
    Set MyOlSelection = Application.ActiveExplorer.Selection

    'Make sure at least one item is selected
    If MyOlSelection.Count <> 1 Then
       Response = MsgBox("Please select a single item", vbExclamation, "Save as PDF")
       Exit Sub
    End If
    'Retrieve the selected item
    Set MySelectedItem = MyOlSelection.Item(1)
    'Get the user's TempFolder to store the item in
    Dim FSO As Object, TmpFolder As Object
    Set FSO = CreateObject("scripting.filesystemobject")
    Set tmpFileName = FSO.GetSpecialFolder(2)
    'construct the filename for the temp mht-file
    strName = "www_howto-outlook_com"
    tmpFileName = tmpFileName & "\" & strName & ".mht"
    'Save the mht-file
    MySelectedItem.SaveAs tmpFileName, olMHTML
    'Create a Word object
    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    Set wrdApp = CreateObject("Word.Application")
    'Open the mht-file in Word without Word visible
    Set wrdDoc = wrdApp.Documents.Open(FileName:=tmpFileName, Visible:=False)
    'Define the SafeAs dialog
    Dim dlgSaveAs As FileDialog
    Set dlgSaveAs = wrdApp.FileDialog(msoFileDialogSaveAs)
    'Determine the FilterIndex for saving as a pdf-file
    'Get all the filters
    Dim fdfs As FileDialogFilters
    Dim fdf As FileDialogFilter
    Set fdfs = dlgSaveAs.Filters

    'Loop through the Filters and exit when "pdf" is found
    Dim i As Integer
    i = 0
    For Each fdf In fdfs
        i = i + 1
        If InStr(1, fdf.Extensions, "pdf", vbTextCompare) > 0 Then
            Exit For
        End If
    Next fdf
    'Set the FilterIndex to pdf-files
    dlgSaveAs.FilterIndex = i
    'Get location of My Documents folder
    Dim WshShell As Object
    Dim SpecialPath As String
    Set WshShell = CreateObject("WScript.Shell")
    SpecialPath = WshShell.SpecialFolders(16)
    'Construct a safe file name from the message subject
    Dim msgFileName As String
    msgFileName = MySelectedItem.Subject

    Set oRegEx = CreateObject("vbscript.regexp")
    oRegEx.Global = True
    oRegEx.Pattern = "[\/:*?""<>|]"
    msgFileName = Trim(oRegEx.Replace(msgFileName, ""))
    'Set the initial location and file name for SaveAs dialog
    Dim strCurrentFile As String
    dlgSaveAs.InitialFileName = SpecialPath & "\" & msgFileName
    'Show the SaveAs dialog and save the message as pdf
    If dlgSaveAs.Show = -1 Then
        strCurrentFile = dlgSaveAs.SelectedItems(1)
        'Verify if pdf is selected
        If Right(strCurrentFile, 4) <> ".pdf" Then
            Response = MsgBox("Sorry, only saving in the pdf-format is supported." & _
                vbNewLine & vbNewLine & "Save as pdf instead?", vbInformation + vbOKCancel)
                If Response = vbCancel Then
                    Exit Sub
                ElseIf Response = vbOK Then
                    intPos = InStrRev(strCurrentFile, ".")
                    If intPos > 0 Then
                       strCurrentFile = Left(strCurrentFile, intPos - 1)
                    End If

                    strCurrentFile = strCurrentFile & ".pdf"
                End If
        End If
        'Save as pdf
        wrdApp.ActiveDocument.ExportAsFixedFormat OutputFileName:= _
            strCurrentFile, 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
    End If
    Set dlgSaveAs = Nothing
    ' close the document and Word
    Set MyOlNamespace = Nothing
    Set MyOlSelection = Nothing
    Set MySelectedItem = Nothing
    Set wrdDoc = Nothing
    Set wrdApp = Nothing
    Set oRegEx = Nothing

End Sub

Open in new window

I should add I have not tested the code to any great degree.


Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Test your restores, not your backups...
Top Expert 2016
Take a look at this add-in for Outlook, it sounds like it could do just what you are looking for.



Hi Bill - thanks for the pointer - I'll give it a go - the reason given for the addin - ie law firm etc is exactly the reason I have been looking for such an add-in - one thing it doesnt seem to do is print each email on a seperate page ... so whilst I give it a go ... do you think it can be done with VBA ? How do I differentiate each email ?
Bill PrewTest your restores, not your backups...
Top Expert 2016


Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!


Hi Bill,
Yes I saw that and am in the process of giving it a run ...
Bill PrewTest your restores, not your backups...
Top Expert 2016

Just curious, so why wouldn’t you have selected my comment as solution?
Bill PrewTest your restores, not your backups...
Top Expert 2016

Based on the author comment in their close of "Thanks Bill - no one commented on the coding - so your add in is the best answer :-)" I would expect the following to be the accepted solution.



Thanks Bill - originally I thought I had accepted your suggestion ...

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial