0 votes
in VBA by Beginner (2 points)

Select email in Outlook with 2 pdfs. Run macro to Merge the 2 pdfs and Save as the name of the 1st pdf.     I receive 40 emails a day that need the pdfs combined prior to uploading.  All coming from same sender and received into the same folder.  Only variables are part of the subject line and name of the first pdf. All contain  2nd pdf always named Summary.pdf 

I have Adobe X

So far I can only select all the emails necessary and mass save the pdfs to the same folder.. Then I manually match and combine PDF Document {Contract} with corresponding SummaryXXXXX.pdf, then combine and Save As and overwrite Contract name. pdf.   All Summary.pdfs are automatically renamed because they share the same name.  I must open each in order to match


Public Sub saveAttachtoDiskC(itm As Outlook.MailItem)

    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim dateFormat

        dateFormat = Format(itm.ReceivedTime, "mmddyy Hmm")
        saveFolder = "C:\Users\nhorn\Desktop\DONE\ECR OMW"

        For Each objAtt In itm.Attachments
            If InStr(objAtt.DisplayName, ".pdf") Then
                objAtt.SaveAsFile saveFolder & "" & itm.Subject & " " & dateFormat & ".pdf"
                Set objAtt = Nothing
            End If

End Sub

This is the saving macro script I have been using.


1 Answer

0 votes
by Super Expert (3.2k points)

 You'll want to save the names of the saved PDFs into an array and then MergePDFs routine in our tutorial on combining PDFs with VBA. Your script will look something like this:

Sub ExportPDFs()
 Dim myOlExp As Outlook.Explorer
 Dim myOlSel As Outlook.Selection
 Dim oMail As Outlook.MailItem
 Set myOlExp = Application.ActiveExplorer
 Set myOlSel = myOlExp.Selection
 For x = 1 To myOlSel.Count
    If myOlSel.Item(x).Class = OlObjectClass.olMail Then
        Set oMail = myOlSel.Item(x)
        saveAttachtoDiskC oMail
    End If
 Next x
End Sub

Public Sub saveAttachtoDiskC(itm As Outlook.MailItem)

    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim dateFormat
    Dim strArray() As String
    Dim i As Integer

        dateFormat = Format(itm.ReceivedTime, "mmddyy Hmm")
        saveFolder = "C:\Users\nhorn\Desktop\DONE\ECR OMW"
        i = 0
        For Each objAtt In itm.Attachments
            If InStr(objAtt.DisplayName, ".pdf") Then
                If i = 0 Then ReDim strArray(i)
                If i > 0 Then ReDim Preserve strArray(i)
                strArray(i) = saveFolder & "\" & itm.Subject & " " & dateFormat & objAtt.DisplayName & ".pdf"
                objAtt.SaveAsFile saveFolder & "\" & itm.Subject & " " & dateFormat & objAtt.DisplayName & ".pdf"
                Set objAtt = Nothing
                i = i + 1
            End If
        Call MergePDFs(strArray, saveFolder & "\" & itm.Subject & " " & dateFormat & ".pdf") 'merge the PDFs and save them with the name of the 1st PDF
        'delete all the temporary PDFs and only keep the combined version
        For i = LBound(strArray) To UBound(strArray)
            Kill strArray(i) 'deletes file
        Next i
End Sub

Private Function MergePDFs(arrFiles() As String, strSaveAs As String) As Boolean
'---PROGRAM: MergePDFs------------------------------------------------------------------------------
'---DEVELOPER: Ryan Wells (wellsr.com)--------------------------------------------------------------
'---DATE: 09/2017-----------------------------------------------------------------------------------
'---DESCRIPTION: This function uses Adobe Acrobat (won't work with just the Reader!) to-------------
'--- combine PDFs into one PDF and save the new PDF with its own file name.-------------
'---INPUT: The function requires two arguments.-----------------------------------------------------
'--- 1) arrFiles is an array of strings containing the full path to each PDF you want to------
'--- combine in the order you want them combined.------------------------------------------
'--- 2) strSaveAs is a string containing the full path you want to save the new PDF as.-------
'---REQUIREMENTS: 1) Must add a reference to "Adobe Acrobat X.0 Type Library" or "Acrobat"----------
'--- under Tools > References. This has been tested with Acrobat 6.0 and 10.0.------
'---CAUTION: This function won't work unless you have the full Adobe Acrobat. In other words,-------
' Adobe Reader will not work.------------------------------------------------------------
Dim objCAcroPDDocDestination As Acrobat.CAcroPDDoc
Dim objCAcroPDDocSource As Acrobat.CAcroPDDoc
Dim i As Integer
Dim iFailed As Integer
On Error GoTo NoAcrobat:
'Initialize the Acrobat objects
Set objCAcroPDDocDestination = CreateObject("AcroExch.PDDoc")
Set objCAcroPDDocSource = CreateObject("AcroExch.PDDoc")
'Open Destination, all other documents will be added to this and saved with
'a new filename
objCAcroPDDocDestination.Open (arrFiles(LBound(arrFiles))) 'open the first file
'Open each subsequent PDF that you want to add to the original
  'Open the source document that will be added to the destination
    For i = LBound(arrFiles) + 1 To UBound(arrFiles)
        objCAcroPDDocSource.Open (arrFiles(i))
        If objCAcroPDDocDestination.InsertPages(objCAcroPDDocDestination.GetNumPages - 1, objCAcroPDDocSource, 0, objCAcroPDDocSource.GetNumPages, 0) Then
          MergePDFs = True
          'failed to merge one of the PDFs
          iFailed = iFailed + 1
        End If
    Next i
objCAcroPDDocDestination.Save 1, strSaveAs 'Save it as a new name
Set objCAcroPDDocSource = Nothing
Set objCAcroPDDocDestination = Nothing
If iFailed <> 0 Then
    MergePDFs = False
End If
On Error GoTo 0
End Function

The ExportPDFs macro goes through each of the selected items in your Outlook explorer pane and saves all the PDFs in each email with temporary names. It then combines the PDFs from each email into one PDF and deletes all the temporary PDFs. 

As emphasised in the tutorial you'll need to to add a reference to "Adobe Acrobat X.0 Type Library" or "Acrobat" under Tools > References in your VBA editor. It won't work unless you have the full version of Acrobat installed (i.e., it won't work with Adobe Reader).

Welcome to wellsr Q&A
wellsr Q&A is the VBA and Python programming community that rewards you for learning how to code.

Getting Started
VBA Cheat Sheets (On Sale Now)

Earn free prizes for asking VBA and Python questions and for answering questions asked by others in our community.

Looking for something else? Hire our professional VBA Help, instead.

What makes us different?
Our points system rewards you with a chance for free gifts based on the quality of your questions and answers. All you have to do is post and you could get rewarded, like these members:

ParserMonster $25 Amazon Gift Card
Hightree $10 Amazon Gift Card
Thales1 $10 Amazon Gift Card
runfunke $10 Amazon Gift Card
coolag $10 Amazon Gift Card
Siew Hun $10 Amazon Gift Card

So, why don't you join us? It really is an encouraging way to motivate members in our VBA and Python community.


For more programming tips visit the VBA Tutorials Blog and the Python Tutorials Blog.