0 votes
in VBA by Beginner (5 points)
reopened by

The question I have is that everything detailed below does work but if I have a folder with several pdf files and what I want is to have an unlimited number of strPDFs (VBA); because it varies my quantity of pdf's to combine.

https://wellsr.com/vba/2017/word/combine-pdfs-with-vba-and-adobe-acrobat/

1 Answer

0 votes
by Super Expert (3.2k points)
selected by
 
Best answer

It sounds like what you want to do is combine our macro for looping through files in a folder with our macro for combining PDFs. To dynamically so your array, you'll also want to combine these skills with the skills outlined in our ReDim Preserve VBA tutorial.

To combine all the PDFs in a folder without individually typing the path of the files you want to combine, your macro would look something like this:

Sub MergeAllPDFsInFolder()
'---------------------------------------------------------------------------------'
'MAIN ROUTINE: Merge all PDFs in the folder strFolder                             '
' Adapted from from the following VBA tutorials:                                  '
'  (1) https://wellsr.com/vba/2017/word/combine-pdfs-with-vba-and-adobe-acrobat/  '
'  (2) https://wellsr.com/vba/2016/excel/vba-loop-through-files-in-folder/        '
'  (3) https://wellsr.com/vba/2016/excel/dynamic-array-with-redim-preserve-vba/   '
'---------------------------------------------------------------------------------'
    Dim strPDFs() As String
    Dim file As Variant
    Dim iCount As Long
    Dim bSuccess As Boolean
    Dim strDir As String
    Dim strType As String
    Dim strFinalPDF As String
    
    '---------------------
    'DEFINE YOUR VARIABLES
    strType = "*pdf" 'file type: PDFs
    strDir = "C:\Users\Ryan\Documents\MyFolder\" 'Folder containing all your PDFs
    strFinalPDF = "C:\Users\Ryan\Desktop\MyNewPDF.pdf" 'Name you want to give your final PDF
    '---------------------
    
    If Right(strDir, 1) <> "\" Then strDir = strDir & "\"
    file = Dir(strDir & strType)
    While (file <> "")
        'Do what you want with the file here
        ' -The file name is stored as the variable "file"
        ' -The directory + file name can be retrieved with "strDir & file"
        If iCount = 0 Then
            ReDim strPDFs(iCount)
        Else
            ReDim Preserve strPDFs(0 To iCount)
        End If
        strPDFs(iCount) = strDir & file
        iCount = iCount + 1
        file = Dir
    Wend
    
    'NOW MERGE strPDFs into a single PDF
    bSuccess = MergePDFs(strPDFs, strFinalPDF)

    If bSuccess = False Then MsgBox "Failed to combine all PDFs", vbCritical, "Failed to Merge PDFs"

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
        Else
          'failed to merge one of the PDFs
          iFailed = iFailed + 1
        End If
        objCAcroPDDocSource.Close
    Next i
objCAcroPDDocDestination.Save 1, strSaveAs 'Save it as a new name
objCAcroPDDocDestination.Close
Set objCAcroPDDocSource = Nothing
Set objCAcroPDDocDestination = Nothing
 
NoAcrobat:
If iFailed <> 0 Then
    MergePDFs = False
End If
On Error GoTo 0
End Function

Simply update the variables strDir and strFinalPDF in the MergeAllPDFsInFolder routine, then run it. These two variables represent the folder containing all the PDFs you want to combine and the destination folder+filename for your combined PDF.

by Beginner (5 points)
Thank you, it really helps a lot but just to finish doing my programming.

If my list belongs, for example, to a range of cells from Column A2 to Column A25, is it an example, how would I print the pdfs that are in that range of cells?
by Super Expert (3.2k points)

Great question! To combine the PDFs in the range A2:A25, you would replace the MergeAllPDFsInFolder macro above with the following routine:

Sub MergeAllPDFsInFolder()
'MAIN ROUTINE: Merge all PDFs in the folder strFolder
' Adapted from from the following VBA tutorials:
'  (1) https://wellsr.com/vba/2017/word/combine-pdfs-with-vba-and-adobe-acrobat/
'  (2) https://wellsr.com/vba/2016/excel/dynamic-array-with-redim-preserve-vba/
    Dim strPDFs() As String
    Dim iCount As Long
    Dim bSuccess As Boolean
    Dim strFinalPDF As String
    Dim cell As Range
    
    '---------------------
    'DEFINE YOUR VARIABLES
    strFinalPDF = "C:\Users\Ryan\Desktop\MyNewPDF.pdf" 'Name you want to give your final PDF
    '---------------------

    For Each cell In Range("A2:A25")
        If iCount = 0 Then
            ReDim strPDFs(iCount)
        Else
            ReDim Preserve strPDFs(0 To iCount)
        End If
        strPDFs(iCount) = cell.Value
        iCount = iCount + 1
    Next cell

    'NOW MERGE strPDFs into a single PDF
    bSuccess = MergePDFs(strPDFs, strFinalPDF)

    If bSuccess = False Then MsgBox "Failed to combine all PDFs", vbCritical, "Failed to Merge PDFs"
End Sub

Notice how I gave the range in the "For" loop declaration

by Beginner (5 points)
Success !! Now apologizing the boldness everything is OK, but if in case I no longer want to modify the Macro VBA I mean the ranges, and I want you to only consider me cells A2 until A25 (example) but only look at the ones that have content. I mean that in that range of cells I can only use only from A2 to A9 (example), and I want to avoid entering the VBA macro to modify the range number and that I only consider the cells with content and not the empty ones Thank you very much for answering
by Super Expert (3.2k points)

No problem! If your PDF names are always stored in column A, you can replace the the For Each loop with the following snippet:

    Dim lastrow As Long
    lastrow = Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To lastrow
        If Trim(Range("A" & i)) <> "" Then
            If iCount = 0 Then
                ReDim strPDFs(iCount)
            Else
                ReDim Preserve strPDFs(0 To iCount)
            End If
            strPDFs(iCount) = Range("A" & i)
            iCount = iCount + 1
        End If
    Next i

If the PDF names aren't always in column A, you could modify the code to search the entire UsedRange and add a check on each cell to see if it ends in a ".pdf" like this:

    For Each cell In ActiveSheet.UsedRange
        If UCase(Right(cell, 4)) = ".PDF" Then
            If iCount = 0 Then
                ReDim strPDFs(iCount)
            Else
                ReDim Preserve strPDFs(0 To iCount)
            End If
            strPDFs(iCount) = cell.Value
            iCount = iCount + 1
        End If
    Next cell

Any cell ending with a ".pdf" will be added to strPDFs, regardless of where it is on the spreadsheet. I hope this helps!

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
Register
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.

Register

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

...