Merge PDF documents 3

[BGuidry]

thread705-1272718
I would like to revisit the closed thread, above. It works great, but I would like to adjust it to loop through all PDF files in a specific directory, and merge all files found (perhaps merge to "Source1.pdf" in the example below).

Can anyone please help guide me? Original code below:

Sub TestCombinePDF()
'Relies on the Adobe Acrobat 6.0 Type Library
Dim objCAcroPDDocDestination As Acrobat.CAcroPDDoc
Dim objCAcroPDDocSource As Acrobat.CAcroPDDoc

'Initialize the 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 ("C:\Source1.pdf")

'Do your loop here to open subsequent documents that you want to add
'Do
'Open the source document that will be added to the destination
objCAcroPDDocSource.Open ("C:\Source2.pdf")
If objCAcroPDDocDestination.InsertPages(objCAcroPDDocDestination.GetNumPages - 1, objCAcroPDDocSource, 0, objCAcroPDDocSource.GetNumPages, 0) Then
'-1 Success
Else
'0 problem
End If
objCAcroPDDocSource.Close
'loop

objCAcroPDDocDestination.Save 1, "C:\Destination.pdf"
objCAcroPDDocDestination.Close
Set objCAcroPDDocSource = Nothing
Set objCAcroPDDocDestination = Nothing
End Sub

Barry
GIS Specialist

 

[kjv1611]

here's the instruction for it in the code:

'Do your loop here to open subsequent documents that you want to add
'Do
'Open the source document that will be added to the destination

Are you meaning you don't know how to loop through the documents?

I'd suggest using the FileSystemObject, best I recall... I can dig it up, but basically, you have to set an Object Reference to FileScripting Object... or either ...Script Host... would have to look it up again..

The code for that would be something like:

Dim fso as Scripting.FileSystemObject
Dim f as File
Dim fldr as Folder

Set fso = New Scripting.FileSystemObject
Set fldr = fso("YourFolderPath")

For Each f in fldr.Files
  If Instr(f.Name,"pdf") Then
    'Do your code here to add this file to your other file...
  End If
Next f

Set f = Nothing
Set fldr = Nothing
Set fso = Nothing
'... etc

That is by no means complete... I'm just going off of memory, I'd have to look it up to find the exact context.

Post back with questions, results, etc..

 

[PHV]

Why not simply use the native Dir function ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[BGuidry]

Tried this

Private Sub Command55_Click()
Dim objCAcroPDDocDestination As Acrobat.AcroPDDoc
Dim objCAcroPDDocSource As Acrobat.AcroPDDoc
Dim fso As Scripting.FileSystemObject
Dim f As File
Dim fldr As Folder

'Initialize the objects
Set fso = New Scripting.FileSystemObject
Set fldr = fso("d:\temp\")

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 ("d:\temp\Source1.pdf")

'Do your loop here to open subsequent documents that you want to add
For Each f In fldr.Files
If InStr(f.Name, "pdf") Then
'Open the source document that will be added to the destination

objCAcroPDDocSource.Open (f)
If objCAcroPDDocDestination.InsertPages(objCAcroPDDocDestination.GetNumPages - 1, objCAcroPDDocSource, 0, objCAcroPDDocSource.GetNumPages, 0) Then
'-1 Success
    End If
'    Next f

Else
'0 problem
End If

objCAcroPDDocSource.Close

objCAcroPDDocDestination.Save 1, "D:\temp\Destination.pdf"
objCAcroPDDocDestination.Close
Set f = Nothing
Set fldr = Nothing
Set fso = Nothing
Set objCAcroPDDocSource = Nothing
Set objCAcroPDDocDestination = Nothing

End Sub

And still getting "Compile Error: For without Next", but pretty sure there is still something that I am missing in the code.

Barry
GIS Specialist

 

[kjv1611]

That's b/c

For without Next

You really are missing the "Next"

Looks like it should be right after this section:

Else
'0 problem
End If

objCAcroPDDocSource.Close

 

[kjv1611]

One thing that always helps me in keeping things like that straight is using proper indentation

For example:

Private Sub TestSomething
	Dim strMyStringVar() As String
	Dim x As Integer
	Dim db As DAO.Database
	Dim rs As DAO.Recordset
	
	Set db = CurrentDb
	Set rs = db.OpenRecordset("MyTableName")
	
	Redim strMyStringVar(rs.Fields.Count)
	
	For x = 1 to 100
		strMyStringVar(x) = rs.Fields(1)
	Next x
		
	For x = 1 to 100
		If InStr(strMyStringVar(x),"SomethingSilly") Then
			If Len(strMyStrVar(x) > 12 Then
				Select Case Len(strMyStringVar(x))
					Case > 12 AND < 20
						'Do something here
					Case >=20 < 50
						'Do something else
					Case Else
						'Whatever else hasn't been done
				End Case
			End If
		End If
	Next x
	
	rs.Close
	Set rs = Nothing
	db.Close
	Set db = Nothing
	Erase strMyStrVar
End Sub

There's probably some typos in there, and I may have used a wrong keyword somewhere, but hopefully that'll show how to line things up to where it's easy to see what's going on at a glance.

 

[kjv1611]

This might be the fix:

Private Sub Command55_Click()
	Dim objCAcroPDDocDestination As Acrobat.AcroPDDoc
	Dim objCAcroPDDocSource As Acrobat.AcroPDDoc
	Dim fso As Scripting.FileSystemObject
	Dim f As File
	Dim fldr As Folder

'Initialize the objects
	Set fso = New Scripting.FileSystemObject
	Set fldr = fso("d:\temp\")

	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 ("d:\temp\Source1.pdf")

'Do your loop here to open subsequent documents that you want to add
	For Each f In fldr.Files
		If InStr(f.Name, "pdf") Then
			'Open the source document that will be added to the destination

			objCAcroPDDocSource.Open (f)
				If objCAcroPDDocDestination.InsertPages(objCAcroPDDocDestination.GetNumPages - 1, objCAcroPDDocSource, 0, objCAcroPDDocSource.GetNumPages, 0) Then
					'-1 Success
				End If
		Else
			'0 problem
		End If
    Next f

objCAcroPDDocSource.Close

objCAcroPDDocDestination.Save 1, "D:\temp\Destination.pdf"
objCAcroPDDocDestination.Close
Set f = Nothing
Set fldr = Nothing
Set fso = Nothing
Set objCAcroPDDocSource = Nothing
Set objCAcroPDDocDestination = Nothing

End Sub

You had the "Next" commented out, and it looks like it was in the wrong place before... I uncommented and moved it after properly indenting the whole thing - just makes it easier to read.

 

[PHV]

Have a look here:

http://www.oaltd.co.uk/Indenter/Default.htm

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[kjv1611]

Thanks for that link, PHV. Looks like a nifty tool. I wonder whether or not M-Z Tools for VBA does this as well, b/c I know it does a lot of stuff. I've just not used it in a while... installed, but not actually used that I can remember. I looked, and didn't see any such options.

 

[BGuidry]

Thanks, kjv1611. As you have adjusted the code for me, now states:

Runtime error '438': Object doesn't support this property or method

on the line

Set fldr = fso("d:\temp\")

I think I'll go ahead and just rework the report properties to print all pages to the same pdf file.

Barry
GIS Specialist

 

[kjv1611]

Sorry.

Should be this:
Set fldr = fso.[highlight]GetFolder([/highlight]"d:\temp\"[highlight])[/highlight]

 

[BGuidry]

Rather than attempting to merge the pdf files into one, I copied the report to another, got rid of the parameter that was restricting it to a single page/record, and created a combo dialog box (form). With this I made based on a list (of several years; hope I can add to this later).

The query, behind the report, has a parameter to query the Right([Date],4) to match the criteria of the value in the combo box: "Forms!frmYear!cboYr".

The code below is then run from the dialog box's 'AfterUpdate' property event:

Private Sub cboYear_AfterUpdate() 

Dim dbs As Database
Dim rst As Recordset
Dim Report As Recordset
Dim path As String
Dim count As Integer
Dim yr As String

Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("Well Maintenance Activity Table")
path = "d:\temp\" (for testing purposes)
yr = Me.cboYr

        FileName = path & "Well Maintenance Logbook Report " & yr & ".pdf"


        DoCmd.OutputTo acOutputReport, "Well Maintenance Annual Report", acFormatPDF, FileName, False

MsgBox ("Report completed successfully")
End Sub

I wanted to have it leave the dialog box open so the user may continue generating reports for various years, and created a "Cancel" button on the dialog, using a macro to close the form.

Thanks.

Barry
GIS Specialist