Option Explicit


'Need to set these references using Tools / References:

'Microsoft Scripting Runtime

'Adobe Acrobat 5.0 Type Library



Const PDF_WILDCARD = "*.pdf"


'Avoid having to load Acrobat for each file printed

Private AcroExchApp As Object


'Static variable - keep track of total page count

Private miPages             As Integer



Private Sub Command1_Click()



Dim lsDir As String

Set AcroExchApp = CreateObject("AcroExch.App")


'Change this as desired

lsDir = "G:\ea2F\2006 cd-rom\Handouts\Section7"


If MsgBox(lsDir & "- is this the correct directory?", vbYesNo, "Merge Acrobat PDF files") = vbYes Then


    'Merge PDF files

    Call LoadPrintList(lsDir & "\")


    'Close Acrobat Exchange



    'Show page count

    Debug.Print "Page count "; miPages


End If


'Comment this out for VBA

'Unload Me


End Sub



Private Sub LoadPrintList(ByVal bsFolder As String)



Dim lsNames(100) As String

Dim liNum        As Integer


If LoadFileNames(ByVal bsFolder, lsNames, liNum) = True Then _

    Call MergeListPDF(ByVal bsFolder, lsNames, ByVal liNum)


End Sub


Private Sub MergeListPDF(ByVal bsFolder As String, _

    asNames() As String, ByVal biNum As Integer)


Dim liCnt   As Integer

Dim loFso   As New FileSystemObject

Dim loFil   As File


    Set loFso = CreateObject("Scripting.FileSystemObject")

    On Error GoTo ErrHandler


    'Load each file, one at a time

    For liCnt = 1 To biNum

        Set loFil = loFso.GetFile(bsFolder + asNames(liCnt))


        If MergeOnePDF(bsFolder, asNames(liCnt)) = False Then GoTo ErrHandler



Exit Sub




    'For debugging



End Sub



Private Function LoadFileNames(ByVal bsFolderPath As String, _

    asNames() As String, aiNum As Integer) As Boolean



Dim lsPDFList   As String

Dim liUnit      As Integer      'Unit number for file I/O

Dim liCnt       As Integer      'Index for array of file names

Dim lsData      As String       'Original record from INI file


    liUnit = FreeFile

    LoadFileNames = False


    If Dir$(bsFolderPath & "pdf.txt") <> "" Then

        Debug.Print bsFolderPath & "pdf.txt"


        'Data file pdf.txt created by using Pdfdir.bat:


        '@echo off


        'Rem This produces list of PDF file names

        'Rem in sorted order (alphabetic)


        'dir *.pdf /B /O:N >pdf.txt


        'Now need to read file names from data file

        Open bsFolderPath & "pdf.txt" For Input As #liUnit



            Line Input #liUnit, lsData

            'Added for testing

            If LCase$(Trim$(lsData)) = "stop" Then GoTo StopLooping


            liCnt = 1 + liCnt

            'Load into array

            asNames(liCnt) = lsData

            Debug.Print liCnt; " "; asNames(liCnt)


        Loop Until EOF(liUnit)




        Close (liUnit)


        'Return count of file names

        aiNum = liCnt


        'Indicate success

        LoadFileNames = True



        'Indicate failure

        MsgBox "PDF.txt file not found", , bsFolderPath & "pdf.txt"

    End If


End Function


'This is a modified version of a routine from PlanetPDF

' That routine allowed you to insert a single page multiple times in one file


'The routine is HowToImportTheSamePageManyTimes, located here:





Function MergeOnePDF(ByVal bsFolder As String, ByVal bsFileName As String) As Boolean



    Dim AcroExchPDDocTarget As Object

    Dim AcroExchPDDocSource As Object


    Dim strSourceFileName As String

    Dim strPath As String

    Dim strTargetFileName As String


    Dim iSourcePageToInsert As Integer

    Dim iTargetPageToInsertAfter As Integer

    Dim iInsertCount As Integer

    Dim iNumberPages As Integer



    Debug.Print bsFolder; bsFileName


    ' Create our PDDoc object

    Set AcroExchPDDocTarget = CreateObject("AcroExch.PDDoc")


    ' Show the Acrobat Exchange window



    ' Set the path

    'strPath = WORKING_PATH

    strPath = bsFolder


    ' Set the target file

    strTargetFileName = "merged.pdf"


    ' Set the page to insert after (note this is being converted to base 0)

    iTargetPageToInsertAfter = miPages


    ' Open the target file (the file that we wish to insert pages into)

    If (AcroExchPDDocTarget.Open(strPath + strTargetFileName) = False) Then

        MsgBox "Could not open " + strPath + strTargetFileName

        Exit Function

    End If


    ' Set the source filename

    strSourceFileName = bsFileName


    ' Open the source file (that contains the page we wish to insert)

    Set AcroExchPDDocSource = CreateObject("AcroExch.PDDoc")


    If (AcroExchPDDocSource.Open(strPath + strSourceFileName) = False) Then

        MsgBox "Could not open " + strPath + strSourceFileName

        Exit Function

    End If


    ' Get the number of pages for source pdf

    iNumberPages = AcroExchPDDocSource.GetNumPages


    'Always insert at same location - must insert pages in reverse order

    For iSourcePageToInsert = iNumberPages - 1 To 0 Step -1

        ' Insert the pages

        If (AcroExchPDDocTarget.InsertPages(iTargetPageToInsertAfter, AcroExchPDDocSource, _

            iSourcePageToInsert, 1, True) = False) Then

        'Do nothing



'un-comment these lines for Acrobat 7

'comment these lines for Acrobat 5


            'Acrobat 7 - only need to insert once

            Exit For



        End If



    'Keep track of total pages in target PDF

    miPages = miPages + iNumberPages


    ' Close the source document



    ' Save the entire target document where it was

    '***** note

    'this saves over the top of the existing file

    AcroExchPDDocTarget.Save &H1, strPath + AcroExchPDDocTarget.GetFileName


    ' Close the PDDoc



    ' Cleanup the Acrobat objects

    Set AcroExchPDDocTarget = Nothing

    Set AcroExchPDDocSource = Nothing


    MergeOnePDF = True


End Function