Well, I'm bad at this, so, please help! I have code that pulls pdf files and saves them as a binder. It all works, but as I expand the code, I start creating a lot of repetitious things that can probably be lopped, but I'm just not bright enough to get my head around it. Below is the code that will create the first doc from a tab as a cover sheet, and pull 2 more existing files into the binder. I would like to do this with up to 100 without haveing to copy and paste the code so many times.
Sub Build_Packet()
Dim AcroApp As Acrobat.CAcroApp
Dim Part1Document As Acrobat.CAcroPDDoc
Dim numPages As Integer
Set AcroApp = CreateObject("AcroExch.App")
Set Part1Document = CreateObject("AcroExch.PDDoc")
Set Part2Document = CreateObject("AcroExch.PDDoc")
Set Part3Document = CreateObject("AcroExch.PDDoc")
' Open Part1Document and save as Binder Name
Sheets("Planning").Range("A1:B40").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
(Worksheets("RefData").Range("PACKETPREFIX") & "\tempcover.pdf"), Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
' Open Part1Document as cover sheet to append additional pdfs
Part1Document.Open (Worksheets("RefData").Range("PACKETPREFIX") & "\tempcover.pdf")
' Open PartcDocuments to be appended into Part1Document
If Worksheets("Planning").Range("FILE1") = "" Then
Else
Part2Document.Open (Worksheets("RefData").Range("FILEPREFIX") & "" & Worksheets("Planning").Range("FILE1"))
End If
If Worksheets("Planning").Range("FILE2") = "" Then
Else
Part3Document.Open (Worksheets("RefData").Range("FILEPREFIX") & "" & Worksheets("Planning").Range("FILE2"))
End If
' Append PartxDocument files into Part1Document
numPages = Part1Document.GetNumPages()
' AppendPart2Document
If Worksheets("Planning").Range("FILE1") = "" Then
Else
If Part1Document.InsertPages(numPages - 1, Part2Document, 0, Part2Document.GetNumPages(), True) = False Then
MsgBox "Cannot insert page 1"
End If
End If
If Part1Document.Save(PDSaveFull, Worksheets("RefData").Range("PACKETPREFIX") & "" & Worksheets("RefData").Range("PACKETNAME") & ".pdf") = False Then
MsgBox "Cannot save the modified document"
End If
' AppendPart3Document
If Worksheets("Planning").Range("FILE2") = "" Then
Else
If Part1Document.InsertPages(numPages - 1, Part3Document, 0, Part3Document.GetNumPages(), True) = False Then
MsgBox "Cannot insert page 1"
End If
End If
If Part1Document.Save(PDSaveFull, Worksheets("RefData").Range("PACKETPREFIX") & "" & Worksheets("RefData").Range("PACKETNAME") & ".pdf") = False Then
MsgBox "Cannot save the modified document"
End If
' ClosebPartxDocuments
Part1Document.Close
Part2Document.Close
Part3Document.Close
' Not sure what this does
AcroApp.Exit
Set AcroApp = Nothing
Set Part1Document = Nothing
Set Part2Document = Nothing
Set Part3Document = Nothing
MsgBox "Packet Complete. Go To: " & Worksheets("RefData").Range("PACKETPREFIX") & " To Access File: " & Worksheets("RefData").Range("PACKETNAME")
' Delete the Part1Document file cover sheet
Dim KillFile As String
KillFile = Worksheets("RefData").Range("PACKETPREFIX") & "\tempcover.pdf"
'Check that file exists
If Len(Dir$(KillFile)) > 0 Then
'First remove readonly attribute, if set
SetAttr KillFile, vbNormal
'Then delete the file
Kill KillFile
End If
End Sub
Sub Build_Packet()
Dim AcroApp As Acrobat.CAcroApp
Dim Part1Document As Acrobat.CAcroPDDoc
Dim numPages As Integer
Set AcroApp = CreateObject("AcroExch.App")
Set Part1Document = CreateObject("AcroExch.PDDoc")
Set Part2Document = CreateObject("AcroExch.PDDoc")
Set Part3Document = CreateObject("AcroExch.PDDoc")
' Open Part1Document and save as Binder Name
Sheets("Planning").Range("A1:B40").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
(Worksheets("RefData").Range("PACKETPREFIX") & "\tempcover.pdf"), Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
' Open Part1Document as cover sheet to append additional pdfs
Part1Document.Open (Worksheets("RefData").Range("PACKETPREFIX") & "\tempcover.pdf")
' Open PartcDocuments to be appended into Part1Document
If Worksheets("Planning").Range("FILE1") = "" Then
Else
Part2Document.Open (Worksheets("RefData").Range("FILEPREFIX") & "" & Worksheets("Planning").Range("FILE1"))
End If
If Worksheets("Planning").Range("FILE2") = "" Then
Else
Part3Document.Open (Worksheets("RefData").Range("FILEPREFIX") & "" & Worksheets("Planning").Range("FILE2"))
End If
' Append PartxDocument files into Part1Document
numPages = Part1Document.GetNumPages()
' AppendPart2Document
If Worksheets("Planning").Range("FILE1") = "" Then
Else
If Part1Document.InsertPages(numPages - 1, Part2Document, 0, Part2Document.GetNumPages(), True) = False Then
MsgBox "Cannot insert page 1"
End If
End If
If Part1Document.Save(PDSaveFull, Worksheets("RefData").Range("PACKETPREFIX") & "" & Worksheets("RefData").Range("PACKETNAME") & ".pdf") = False Then
MsgBox "Cannot save the modified document"
End If
' AppendPart3Document
If Worksheets("Planning").Range("FILE2") = "" Then
Else
If Part1Document.InsertPages(numPages - 1, Part3Document, 0, Part3Document.GetNumPages(), True) = False Then
MsgBox "Cannot insert page 1"
End If
End If
If Part1Document.Save(PDSaveFull, Worksheets("RefData").Range("PACKETPREFIX") & "" & Worksheets("RefData").Range("PACKETNAME") & ".pdf") = False Then
MsgBox "Cannot save the modified document"
End If
' ClosebPartxDocuments
Part1Document.Close
Part2Document.Close
Part3Document.Close
' Not sure what this does
AcroApp.Exit
Set AcroApp = Nothing
Set Part1Document = Nothing
Set Part2Document = Nothing
Set Part3Document = Nothing
MsgBox "Packet Complete. Go To: " & Worksheets("RefData").Range("PACKETPREFIX") & " To Access File: " & Worksheets("RefData").Range("PACKETNAME")
' Delete the Part1Document file cover sheet
Dim KillFile As String
KillFile = Worksheets("RefData").Range("PACKETPREFIX") & "\tempcover.pdf"
'Check that file exists
If Len(Dir$(KillFile)) > 0 Then
'First remove readonly attribute, if set
SetAttr KillFile, vbNormal
'Then delete the file
Kill KillFile
End If
End Sub