Option Explicit

'Need to set these references using Tools / References:

'Microsoft Scripting Runtime

'Adobe Acrobat 5.0 Type Library

Const POSTSCRIPT_LEVEL = 2

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

AcroExchApp.Exit

'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

Next

Exit Sub

ErrHandler:

Stop

'For debugging

Resume

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

'Rem This produces list of PDF file names

'Rem in sorted order (alphabetic)

'Rem

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

'Now need to read file names from data file

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

Do

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)

StopLooping:

Close (liUnit)

'Return count of file names

aiNum = liCnt

'Indicate success

LoadFileNames = True

Else

'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:

'http://www.planetpdf.com/developer/article.asp?ContentID=iac_importing_single_pages

'************************************************************************

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

AcroExchApp.Show

' 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

'77777777777777777777777777777777777777777777777777777777777777777777

'un-comment these lines for Acrobat 7

'comment these lines for Acrobat 5

Else

'Acrobat 7 - only need to insert once

Exit For

'77777777777777777777777777777777777777777777777777777777777777777777

End If

Next

'Keep track of total pages in target PDF

miPages = miPages + iNumberPages

' Close the source document

AcroExchPDDocSource.Close

' 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

AcroExchPDDocTarget.Close

' Cleanup the Acrobat objects

Set AcroExchPDDocTarget = Nothing

Set AcroExchPDDocSource = Nothing

MergeOnePDF = True

End Function