VBA to save outlook message and attachments as one PDF file

We are trying to automate the processing of a large number of incoming resumes to store the message and attachments to shared network folders.

Using a combination of Outlook rules and vba script, we know how to get the attachments copied to specific network folders, with each attachment saved as a unique file by including the subject, date/time stamp, and original attachment name as the name of the saved attachment.

Using a macro, we know how to selectively create a pdf version of the Outlook message to specific network folders.  This is currently a manual process involving the selection of a single message to save as pdf, and then selecting the network folder.

We now need to be able to combine the two processes to create a pdf of the message and append the attachments as pdf files to that same pdf file.  The attachments include several different file types, so we want to convert them to pdf to keep them together in one file.

Here is the script used to save the attachments:

Public Sub savetoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim DateFormat As String

DateFormat = Format(Now, "mm_dd_yy_hh_mm_ss")
saveFolder = "\\server\hr\resumes\foldname\"
     For Each objAtt In itm.Attachments
          objAtt.SaveAsFile saveFolder & Format$(itm.Subject & "---" & DateFormat & "---" & objAtt.DisplayName)
          Set objAtt = Nothing
     Next
End Sub

Here is the macro to save the email message as a pdf, copied from a web search, which we need to modify to automatically generate the file name and then save to a specific folder:

Sub SaveAsPDFfile()

    '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
                    wrdDoc.Close
                    wrdApp.Quit
                    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
    wrdDoc.Close
    wrdApp.Quit
    
    'Cleanup
    Set MyOlNamespace = Nothing
    Set MyOlSelection = Nothing
    Set MySelectedItem = Nothing
    Set wrdDoc = Nothing
    Set wrdApp = Nothing
    Set oRegEx = Nothing

End Sub

Any suggestions would be greatly appreciated, since I have only been working with the coding for these processes for a short time.

 

Question Info


Last updated August 17, 2019 Views 4,111 Applies to:

We are trying to automate the processing of a large number of incoming resumes to store the message and attachments to shared network folders.

Using a combination of Outlook rules and vba script, we know how to get the attachments copied to specific network folders, with each attachment saved as a unique file by including the subject, date/time stamp, and original attachment name as the name of the saved attachment.

Using a macro, we know how to selectively create a pdf version of the Outlook message to specific network folders.  This is currently a manual process involving the selection of a single message to save as pdf, and then selecting the network folder.

We now need to be able to combine the two processes to create a pdf of the message and append the attachments as pdf files to that same pdf file.  The attachments include several different file types, so we want to convert them to pdf to keep them together in one file.

Here is the script used to save the attachments:

Public Sub savetoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim DateFormat As String

DateFormat = Format(Now, "mm_dd_yy_hh_mm_ss")
saveFolder = "\\server\hr\resumes\foldname\"
     For Each objAtt In itm.Attachments
          objAtt.SaveAsFile saveFolder & Format$(itm.Subject & "---" & DateFormat & "---" & objAtt.DisplayName)
          Set objAtt = Nothing
     Next
End Sub

Here is the macro to save the email message as a pdf, copied from a web search, which we need to modify to automatically generate the file name and then save to a specific folder:

Sub SaveAsPDFfile()

    '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
                    wrdDoc.Close
                    wrdApp.Quit
                    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
    wrdDoc.Close
    wrdApp.Quit
    
    'Cleanup
    Set MyOlNamespace = Nothing
    Set MyOlSelection = Nothing
    Set MySelectedItem = Nothing
    Set wrdDoc = Nothing
    Set wrdApp = Nothing
    Set oRegEx = Nothing

End Sub

Any suggestions would be greatly appreciated, since I have only been working with the coding for these processes for a short time.

Hi,

To make sure that you get the best answer for this concern, we suggest that you post this query through our Technet IT forum. To do this, visit this link.

Best regards.

Did this solve your problem?

Sorry this didn't help.

Great! Thanks for marking this as the answer.

How satisfied are you with this reply?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this response?

Thanks for your feedback.

It is relatively straightforward to use a macro to save an e-mail message as PDF, but it is a whole different ballgame to save the attachments from that message, created by disparate applications, as PDF, let alone combine them into a single PDF.

For a start Office does not provide a process that will merge PDF files, so you are going to have to consider using third-party software that can be driven by VBA and which will combine PDFs. PDFCreator and Acrobat immediately spring to mind.

Then you are going to have to be able to drive an application for each type of attachment from VBA, in order to open the attachments as temporary files so that they may be printed to the third party PDF tool to create the individual PDFs that will later be combined. That's a big enough ask, as by no means all the attachments you may receive are likely to be from applications that are VBA compatible.

If you want to save messages with their attachments, surely it would be preferable to save them in msg format from which they can be opened at any time in Outlook?

Graham Mayor (Microsoft Word MVP 2002-2019)
For more Word tips and downloads visit my web site
https://www.gmayor.com/Word_pages.htm

Did this solve your problem?

Sorry this didn't help.

Great! Thanks for marking this as the answer.

How satisfied are you with this reply?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this response?

Thanks for your feedback.