batch convert hundreds of outlook 2013 emails into PDF's

Hi all

I've got a colleague who as a huge number of emails he needs to convert into PDF files. At present he has them in a folder within Outlook 2013 and I'm wondering if any of you gurus have some VB we can add into the visual basic section to enable him to batch save these off to a folder.

Many thanks
Neil
LVL 3
Neil ThompsonSenior Systems DeveloperAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

John TsioumprisSoftware & Systems EngineerCommented:
Probably it needs a bit of  fixing but it should get you started (note that i print emails in a folder named Test that is a subfolder of Inbox...)
Public Sub PrintEmails()
 Dim OutApp As Outlook.Application
    Dim oNS As Outlook.NameSpace
    Dim objInboxFolder As Outlook.MAPIFolder
    Dim objDestFolder As Outlook.MAPIFolder
    Dim curFolder As Outlook.MAPIFolder
    Dim Item As MailItem
    
Set OutApp = Application
Set oNS = OutApp.GetNamespace("MAPI")
Set objToPrintFolder = oNS.GetDefaultFolder(olFolderInbox).Parent.Folders("Inbox").Folders("Test")
For Each Item In objToPrintFolder.Items
    Item.PrintOut
Next
End Sub

Open in new window

Neil ThompsonSenior Systems DeveloperAuthor Commented:
I've got this so far. It works perfectly dropping them into a folder called emailPDF in my documents folder but it doesn't also do the attachments to the emails, how could I incorporate that please?

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 & "\emailPDF\" & 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 & "\emailPDF\" & 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
SysToolsData Expert - Recovery,Backup,MigrationCommented:
You can convert the batch of Outlook emails to PDF by performing following steps:
1. Launch MS Outlook
2. Choose your desired email to convert to PDF.
3. Click on File Label -> Save As. Choose your desired location in which you want to save the data.
4. Choose "Save As Type" in the drop-down menu.
5. Select the five format and Click Save.
6. Now go to the location in which you have saved your emails and select the files.
7. Open them in MS-Word.
8. Go to "File" menu, choose 'Save As' option and save your data in PDF Format.
The above manual method has some limitations. As the batch conversion of emails into pdf takes a lot of time.
So, to avoid going through the lengthy and tricky procedure you can choose an alternative SysTools PST to PDF Converter Tool which converts your Outlook PST Files with an ease.
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

Neil ThompsonSenior Systems DeveloperAuthor Commented:
Many thanks, I think manual is out of the window as he has around 1400 emails to sort :(
SysToolsData Expert - Recovery,Backup,MigrationCommented:
Hi,

Thanks for your reply.

For 1000+ emails, the manual solution is not the right choice. So, you can use our specialized solution SysTools PST to PDF Converter to quickly convert PST files to PDF file format. You can even try the demo version of the software for free.
If you have any query regarding the same then please let me know.
John TsioumprisSoftware & Systems EngineerCommented:
Do you mean that besides email you/he has attachements to print...if this is the case then

Private Declare Function apiShellExecute 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

'***App Window Constants***
Public Const WIN_NORMAL = 1         'Open Normal
Public Const WIN_MAX = 3            'Open Maximized
Public Const WIN_MIN = 2            'Open Minimized

'***Error Codes***
Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&


Public Sub PrintEmails()
 Dim OutApp As Outlook.Application
    Dim oNS As Outlook.NameSpace
    Dim objInboxFolder As Outlook.MAPIFolder
    Dim objDestFolder As Outlook.MAPIFolder
    Dim curFolder As Outlook.MAPIFolder
    Dim Item As MailItem
    Dim mAttachment As Attachment
Set OutApp = Application
Set oNS = OutApp.GetNamespace("MAPI")
Set objToPrintFolder = oNS.GetDefaultFolder(olFolderInbox).Parent.Folders("Inbox").Folders("Test")
For Each Item In objToPrintFolder.Items
    Item.PrintOut
    For Each mAttachment In Item.Attachments
        mAttachment.SaveAsFile "C:\Temp\" & mAttachment.FileName
        fPrintFile "C:\Temp\" & mAttachment.FileName
    Next
Next
End Sub
Function fPrintFile(stFile As String)

    ' This function uses ShellExecute to print, rather than
    ' open, the file.

    Dim lRet As Long, varTaskID As Variant
    Dim stRet As String

    lRet = apiShellExecute(hWndAccessApp, "print", _
            stFile, vbNullString, vbNullString, 0&)
            
    If lRet > ERROR_SUCCESS Then
        stRet = vbNullString
        lRet = -1
    Else
        Select Case lRet
            Case ERROR_NO_ASSOC:
                stRet = "Error: No associated application.  Couldn't print!"
            Case ERROR_OUT_OF_MEM:
                stRet = "Error: Out of Memory/Resources. Couldn't print!"
            Case ERROR_FILE_NOT_FOUND:
                stRet = "Error: File not found.  Couldn't print!"
            Case ERROR_PATH_NOT_FOUND:
                stRet = "Error: Path not found. Couldn't print!"
            Case ERROR_BAD_FORMAT:
                stRet = "Error:  Bad File Format. Couldn't print!"
            Case Else:
        End Select
    End If
    fPrintFile = lRet & _
                IIf(stRet = "", vbNullString, ", " & stRet)
End Function

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.