Merge PDF's in excel

[swarmo]

Hi guys,I have a problem that I really hope someone can help with. I need to find a way to merge two PDF's in excel.
I have found some macros but I'm not able to tweak them to suit my requirements.

1) The first PDFs location and filename are dependent on cells (I.e., AA51 = c:\Acme motors\Acme motors - Form.Pdf
It changes with the business name.


2) The second PDF doesn't exist until it's time to merge the two. A worksheet is converted to PDF then merged with the first PDF


3) The first PDF only has 2 pages.(They are the pages of a form that require a signature) The page layout of the merged document must be like this.


MERGED PAGE LAYOUT
PG 1 - (PDF2 PG1)
PG 2 - (PDF2 PG2)
PG 3 - (PDF2 PG3)
PG 4 - (PDF2 PG4)
PG 5 - (PDF2 PG5)
PG 6 - (PDF2 PG6)
PG 7 - (PDF1 PG 1)
PG 8 - (PDF2 PG 7)
PG 9 - (PDF2 PG 8)
PG 10 - ( PDF1 PG 2)


I am trying to find a way to split pages 1-6 and 7-8 of PDF2 and pages 1 & 2 of PDF1. Then merge them in this order. PDF2 PG 1-6, PDF1 PG 1, PDF2 PG 7-8, PDF1 PG 2)


I just can't figure out a way to do it.

Any help would be greatly appreciated

 

[yky]

A worksheet is converted to PDF then merged with the first PDF

What is the name of the workbook that contains the worksheet? Is it a fixed name or it changes from time to time?

 

[swarmo]

Hi, the workbook name will change for every job. Thank you

 

[yky]

See if the following code works for you. I tested on D: drive (D:\ACME MORTORS, instead of C:\ACME MORTORS). It works fine. What is left to be done is deleting the temp files.

The code needs to be in the workbook whose AA51 and AA55 contain the full path of the first and second pdf files. Before running the code, you need to click on the worksheet which will be exported to a 8-page pdf file to make it the active sheet.

Option Explicit
Sub main()
'this script assumes the following:
'1.the full path of a two-page PDF file is in AA51 of THISWORKBOOK.SHEETS(1)
'2. the full path of the destination file in in AA55 of THISWORKBOOK.SHEETS(1)
'3. the 8-page worksheet to be exported as pdf file is the active worksheet
'the script first saves  the active worksheet to a 8-page PDF file named temp1.pdf to the path shown in AA51.
'it then splits temp1.pdf into 8 pdf files each contains one page from temp1.pdf
'it then splits the file whose path is in AA51
'it then merges the first six files/pages from temp1.pdf then the first page from the two-page pdf file, then the remaining two
'pages from temp1.pdf, then the second page from the two-page file.


Dim str As String, myfile As String
Dim myfolder As String
Dim tempfile As String


myfile = ThisWorkbook.Sheets(1).Range("AA51").Value


'remove path prefix
Do While InStr(myfile, "\") <> 0
myfile = Right(myfile, Len(myfile) - InStr(myfile, "\"))


Loop


'get path of file
myfolder = Replace(ThisWorkbook.Sheets(1).Range("AA51").Value, myfile, "")


'save activesheet to temp1.pdf
tempfile = "temp1.pdf"
SaveToPDF myfolder, tempfile


'split temp1.pdf
split_pdf myfolder, tempfile


'split the two-page pdf file
split_pdf myfolder, myfile


merge_pdf myfolder, myfile


End Sub
Sub split_pdf(path As String, filename As String)
Dim PDDoc As Acrobat.CAcroPDDoc, newPDF As Acrobat.CAcroPDDoc
Dim PDPage As Acrobat.CAcroPDPage
Dim thePDF As String
Dim PNum As Long
Dim Result As Integer
Dim i As Integer
Dim newName As String


Set PDDoc = CreateObject("AcroExch.pdDoc")
'path = "D:\Warranty.pdf"


'Result = PDDoc.Open("" & path & filename & ".pdf" & "")
Result = PDDoc.Open(path & filename)
If Not Result Then
   MsgBox "Can't open file: " & path & filename
   Exit Sub
End If


'        ThisWorkbook.FollowHyperlink (path&filename)
PNum = PDDoc.GetNumPages


For i = 0 To PNum - 1
    Set newPDF = CreateObject("AcroExch.pdDoc")
    newPDF.Create
    newName = path & "Page_" & i & "_of_" & filename
    newPDF.InsertPages -1, PDDoc, i, 1, 0
    newPDF.Save 1, newName
    newPDF.Close
    Set newPDF = Nothing
Next i
End Sub
Sub SaveToPDF(myfolder As String, myfile As String)


Dim sht As Worksheet
Dim answer As Boolean


ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:= _
myfolder & myfile _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False




End Sub


Sub merge_pdf(myfolder As String, myfile As String)
Dim gPDDoc1 As AcroPDDoc
Dim gPDDoc2 As AcroPDDoc
Dim i As Integer
Dim j As Integer


Dim chk1 As Integer
Dim chk2 As Integer
Dim mergefile As Integer
Dim savemergefile As Integer




Set gPDDoc1 = CreateObject("AcroExch.PDDoc")
 
chk1 = gPDDoc1.Open(myfolder & "Page_0_of_temp1.pdf")


For i = 1 To 5 Step 1
Set gPDDoc2 = CreateObject("AcroExch.PDDoc")
chk2 = gPDDoc2.Open(myfolder & "Page_" & i & "_of_temp1.pdf")
 
mergefile = gPDDoc1.InsertPages(i - 1, gPDDoc2, 0, 1, 0)


Next i


Set gPDDoc2 = CreateObject("AcroExch.PDDoc")
chk2 = gPDDoc2.Open(myfolder & "Page_" & 0 & "_of_" & myfile)
j = gPDDoc1.GetNumPages()


mergefile = gPDDoc1.InsertPages(i - 1, gPDDoc2, 0, 1, 0)


For i = 6 To 7 Step 1
Set gPDDoc2 = CreateObject("AcroExch.PDDoc")
chk2 = gPDDoc2.Open(myfolder & "Page_" & i & "_of_temp1.pdf")
 
mergefile = gPDDoc1.InsertPages(i, gPDDoc2, 0, 1, 0)


Next i


Set gPDDoc2 = CreateObject("AcroExch.PDDoc")
chk2 = gPDDoc2.Open(myfolder & "Page_" & 1 & "_of_" & myfile)
mergefile = gPDDoc1.InsertPages(i, gPDDoc2, 0, 1, 0)


myfile = ThisWorkbook.Sheets(1).Range("AA55").Value


Do While InStr(myfile, "\") <> 0
myfile = Right(myfile, Len(myfile) - InStr(myfile, "\"))


Loop


savemergefile = gPDDoc1.Save(1, myfolder & myfile)
End Sub

 

[swarmo]

It works perfectly!

Thank you so much for that, you've saved me so much heart ache and frustration!

Thanks again

 

[yky]

Try this one. It works for me. Some unnecessary steps are eliminated and it now deletes temp files. As always, have backup before testing the code.

Option Explicit
Sub main()
'this script assumes the following:
'1.the full path of a two-page PDF file is in AA51 of THISWORKBOOK.SHEETS(1)
'2. the full path of the destination file in in AA54 of THISWORKBOOK.SHEETS(1)
'3. the 8-page worksheet to be exported as pdf file is the active worksheet
'the script first saves  activesheet to a PDF file according to AA51.
'it then splits the two-page pdf file into 2 pdf files,
'it then inserts these two pages into the 8-page pdf as page 7 and page 10.

Dim str As String, myfile As String
Dim myfolder As String
Dim myfile1 As String

myfile = ThisWorkbook.Sheets(1).Range("AA51").Value

'remove path prefix
Do While InStr(myfile, "\") <> 0
myfile = Right(myfile, Len(myfile) - InStr(myfile, "\"))

Loop

myfolder = Replace(ThisWorkbook.Sheets(1).Range("AA51").Value, myfile, "")

'split the two-page pdf file
split_pdf myfolder, myfile

myfile1 = ThisWorkbook.Sheets(1).Range("AA55").Value

'remove path prefix
Do While InStr(myfile1, "\") <> 0
myfile1 = Right(myfile1, Len(myfile1) - InStr(myfile1, "\"))

Loop

'get path of file
myfolder = Replace(ThisWorkbook.Sheets(1).Range("AA55").Value, myfile1, "")

'save activesheet to temp1.pdf
SaveToPDF myfolder, myfile1

insert_pdf myfolder, myfile, myfile1

clean_up myfolder, myfile
End Sub
Sub split_pdf(path As String, filename As String)
Dim PDDoc As Acrobat.CAcroPDDoc, newPDF As Acrobat.CAcroPDDoc
Dim PDPage As Acrobat.CAcroPDPage
Dim thePDF As String
Dim PNum As Long
Dim Result As Integer
Dim i As Integer
Dim newName As String

Set PDDoc = CreateObject("AcroExch.pdDoc")

Result = PDDoc.Open(path & filename)
If Not Result Then
   MsgBox "Can't open file: " & path & filename
   Exit Sub
End If

PNum = PDDoc.GetNumPages

For i = 0 To PNum - 1
    Set newPDF = CreateObject("AcroExch.pdDoc")
    newPDF.Create
    newName = path & "Page_" & i & "_of_" & filename
    newPDF.InsertPages -1, PDDoc, i, 1, 0
    newPDF.Save 1, newName
    newPDF.Close
    Set newPDF = Nothing
Next i
End Sub
Sub SaveToPDF(myfolder As String, myfile As String)

Dim sht As Worksheet
Dim answer As Boolean

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:= _
myfolder & myfile _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False

End Sub

Sub insert_pdf(myfolder As String, myfile As String, myfile1 As String)
Dim gPDDoc1 As AcroPDDoc
Dim gPDDoc2 As AcroPDDoc
Dim i As Integer
Dim j As Integer

Dim chk1 As Integer
Dim chk2 As Integer
Dim mergefile As Integer
Dim savemergefile As Integer

Set gPDDoc1 = CreateObject("AcroExch.PDDoc")
 
chk1 = gPDDoc1.Open(myfolder & myfile1)

Set gPDDoc2 = CreateObject("AcroExch.PDDoc")
chk2 = gPDDoc2.Open(myfolder & "Page_" & 0 & "_of_" & myfile)
 
mergefile = gPDDoc1.InsertPages(5, gPDDoc2, 0, 1, 0)

Set gPDDoc2 = CreateObject("AcroExch.PDDoc")
chk2 = gPDDoc2.Open(myfolder & "Page_" & 1 & "_of_" & myfile)
j = gPDDoc1.GetNumPages()

mergefile = gPDDoc1.InsertPages(8, gPDDoc2, 0, 1, 0)

savemergefile = gPDDoc1.Save(1, myfolder & myfile1)
End Sub
Sub clean_up(myfolder As String, myfile As String)

Kill myfolder & "Page_0_of_" & myfile
Kill myfolder & "Page_1_of_" & myfile

End Sub

 

[swarmo]

That works great. Thanks for the clean code. I had to add a few things for it to work for me, but that code is excellent. You've made my weekend.