PDA

View Full Version : [SOLVED] (PDF VBA and Excel) export cover sheet w/ a loop, attach spec sheet from local drive.



Terriblarius
10-25-2016, 11:18 AM
Hi there. First post here, hopefully it isn't too much for a first shot. I've queried around and this forum seemed like the best shot at getting closer to finishing my project.

So i have a process that i'm trying to automate. For each project that I do, i'm required to submit a compendium of the devices I have used. Each device spec sheet requires a coversheet. Currently, we generate the cover sheets with microsoft word using mail merge, export the result as a pdf, then we use adobe acrobat to manually hunt and insert the spec sheet to each appropriate coversheet.

So, in going forward with automating, i've retooled the database to what you see below:

17404

There is a field to determine what devices you want (Merge? column), the information that needs to be displayed on the coversheet, and a hyperlink to the specsheet on the local drive.

On another worksheet, i've made the template for the cover page that forwards each spec sheet. See below.

17405

At the end of the magic vba loop, this is what is the desired output i want/need.

17406

My attempt to code this has been slow and unsuccessful. below is the code i've made so far, But it doesn't do what i need it to and is a long way away from the desired end.


Option Explicit

Sub Merger()

'Cutsheet Combiner
'this macro is an attempt to create a cutsheet cover using a database, and then attach the actual pdf cutsheet from the hyperlink to X drive.

'declare and variables and dimension

Dim i As Integer
Dim y As Integer
Dim x As Integer
Dim z As Integer

Dim pdfcs As Worksheet
Dim pdfnm As String
Dim flnm As String

Dim dir As String



x = Sheet2.Range("D3") 'starting record in database
y = Sheet2.Range("D4") 'final record in database
'z = Sheet2.Range("D2") 'current record row
dir = Sheet1.Range("E1") 'Base directory as formulated in cell E1 in database
pdfnm = "Combined Cutsheets"
flnm = dir & pdfnm
Set pdfcs = Sheets("Coversheet Template")

'loop thru each row in the data base.

For i = x To y

Sheet2.Cells(2, 4).Value = i
'if range("J3") = "y" then export the cover sheet as pdf to an existing pdf
If Sheet2.Range("J3") = "y" Then

'export as pdf cutsheet to a specific file in directory
pdfcs.ExportAsFixedFormat Type:=xlTypePDF, Filename:=flnm & i - 3, quality:=xlQualityStandard


'also attach the pdf from the hyperlink at range("J9") specific in directory
'not sure how to do this


End If

'Increment the coversheet database row reference by one


Next i


'end loop

'save fully combined pdf document, not sure how to do this.


End Sub



So that's what i have so far, i'm not married to my existing code and open to tearing it down and starting over. I've also attached the .xlsm workbook a workable example.

Thanks in advance, let me know if this is too much for a first post or if you need more info to help with this.

Kenneth Hobs
10-25-2016, 05:42 PM
1. You want to create the cover pdf in Excel rather than MSWord?
2. You want to merge existing pdf files?
a. To merge existing pdf files, you must have a 3rd party application. e.g. Acrobat, not the reader, or PDFCreator v1 or v2, PDFsam, etc. Keep in mind that you users must have this application too. Which did you want to use?
3. Would all of the hyperlinks be based on E2 path?

Tip: When coding, do not use reserved command words for variable names. e.g. Dir().

Terriblarius
10-25-2016, 06:04 PM
Hi Kenneth, thanks for responding.

Software i'm currently using:

Excel 2013
Adobe Acrobat 8 pro (since it's free, and allowed me to drag and drop pdfs for doing this project manually.)


1. You want to create the cover pdf in Excel rather than MSWord?
Not mandatory. The original coversheets were being done in MSword via mail merge. I got this idea of generating the coversheet in excel from another site (I can't seem to post the site - so google "mail merge without word john walkenbach" and it'll come up)


2. You want to merge existing pdf files?
Yes. Existing PDF files (as indicated in the hyperlink in Column G) inserted directly behind the generated cover sheet. (see last image).

a. To merge existing pdf files, you must have a 3rd party application. e.g. Acrobat, not the reader, or PDFCreator v1 or v2, PDFsam, etc. Keep in mind that you users must have this application too. Which did you want to use?

I have acrobat 8 installed and working ok so we can go with that. My corporate laptop is not locked down tho so i can use the other software you mentioned if you feel it's better.

3. Would all of the hyperlinks be based on E2 path?
The hyperlinks for each PDF are located in column G. The existing PDFs are on a local drive.

Cell E2 is where i'd like the finished product to be saved to. The finished product being 1 combined pdf of the compiled coversheet+specsheet combos.

Good call not using dir for a variable.

Kenneth Hobs
10-25-2016, 08:16 PM
Until I get time to put it all together for you, this should give you an idea.



Private Sub CommandButton1_Click()
Dim a As Variant
a = WorksheetFunction.Transpose(Range("A2:A" & Range("A2").End(xlDown).Row).Value)
MergePDFs Range("C2").Value2, Join(a, ","), Range("B2").Value2
End Sub

Sub MergePDFs(MyPath As String, MyFiles As String, Optional DestFile As String = "MergedFile.pdf")' ZVI:2013-08-27 http://www.vbaexpress.com/forum/showthread.php?47310-Need-code-to-merge-PDF-files-in-a-folder-using-adobe-acrobat-X
' Reference required: VBE - Tools - References - Acrobat

Dim a As Variant, i As Long, n As Long, ni As Long, p As String
Dim AcroApp As New Acrobat.AcroApp, PartDocs() As Acrobat.CAcroPDDoc

' Adjust MyPath string if needed.
If Right(MyPath, 1) = "\" Then p = MyPath Else p = MyPath & "\"
a = Split(MyFiles, ",")
ReDim PartDocs(0 To UBound(a))

' Save to MyPath folder if target folder for merged PDF file was not input. (ken)
If InStr(DestFile, "\") = 0 Then DestFile = p & DestFile

On Error GoTo exit_
If Len(Dir(DestFile)) Then Kill DestFile
For i = 0 To UBound(a)
' Check PDF file presence
If Dir(p & Trim(a(i))) = "" Then
MsgBox "File not found" & vbLf & p & a(i), vbExclamation, "Canceled"
Exit For
End If
' Open PDF document
Set PartDocs(i) = CreateObject("AcroExch.PDDoc")
PartDocs(i).Open p & Trim(a(i))
If i Then
' Merge PDF to PartDocs(0) document
ni = PartDocs(i).GetNumPages()
If Not PartDocs(0).InsertPages(n - 1, PartDocs(i), 0, ni, True) Then
MsgBox "Cannot insert pages of" & vbLf & p & a(i), vbExclamation, "Canceled"
End If
' Calc the number of pages in the merged document
n = n + ni
' Release the memory
PartDocs(i).Close
Set PartDocs(i) = Nothing
Else
' Calc the number of pages in PartDocs(0) document
n = PartDocs(0).GetNumPages()
End If
Next

If i > UBound(a) Then
' Save the merged document to DestFile
If Not PartDocs(0).Save(PDSaveFull, DestFile) Then
MsgBox "Cannot save the resulting document" & vbLf & DestFile, vbExclamation, "Canceled"
End If
End If

exit_:

' Inform about error/success
If Err Then
MsgBox Err.Description, vbCritical, "Error #" & Err.Number
ElseIf i > UBound(a) Then
MsgBox "The resulting file was created in:" & vbLf & p & DestFile, vbInformation, "Done"
End If

' Release the memory
If Not PartDocs(0) Is Nothing Then PartDocs(0).Close
Set PartDocs(0) = Nothing

' Quit Acrobat application
AcroApp.Exit
Set AcroApp = Nothing

End Sub

Kenneth Hobs
10-27-2016, 10:31 AM
Add the Acrobat object reference as commented. Change the generic sheet codenames to shtDatabase and shtCover or change the code references.


Sub Main()
Dim fn As String, toPath As String, r As Range, c As Range
Dim v1() As Variant, s1() As String, i As Long, j As Long


With shtDatabase
.Calculate 'update E1 and E2 formulas
If Len(dir(.Range("E1").Value2)) = 0 Then
MsgBox "Save this workbook and retry.", vbCritical, "Macro Ending"
Exit Sub
End If

'Make toPath if needed.
If Len(dir(.Range("E2").Value2, vbDirectory)) = 0 Then MkDir .Range("E2").Value2
toPath = .Range("E2").Value2

'Filter column A
.Range("A3:H3").AutoFilter Field:=1, Criteria1:="y"
Set r = .Range("A3:H3").CurrentRegion.SpecialCells(xlCellTypeVisible)
.Range("A3").AutoFilter 'Remove filter.
If r.Rows.Count = 3 Then Exit Sub 'exit if no filtered data found.

'Make cover pdf file.
fn = toPath & .Range("B1").Value2 & " - Cover.pdf"
shtCover.Range("A7:G51").ExportAsFixedFormat xlTypePDF, fn, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False

'Build string array of pdf files to merge.
j = 0
Set r = Intersect(r, .Columns("G:G"))
v1() = RangeTo1dArray(r)
ReDim s1(0)
s1(0) = fn 'Cover pdf filename.
For i = 3 To UBound(v1)
If Len(dir(v1(i))) > 0 Then
j = j + 1
ReDim Preserve s1(0 To j)
s1(j) = v1(i)
End If
Next i

'Set filename for merged pdf file.
fn = toPath & .Range("B1").Value2 & ".pdf"
End With

MergePDFs Join(s1, ","), fn
End Sub


Function RangeTo1dArray(aRange As Range) As Variant
Dim a() As Variant, c As Range, i As Long
ReDim a(0 To aRange.Cells.Count - 1)
i = i - 1
For Each c In aRange
i = i + 1
a(i) = c
Next c
RangeTo1dArray = a()
End Function


Sub MergePDFs(MyFiles As String, DestFile As String)
' Reference required: VBE - Tools - References - Acrobat

Dim a As Variant, i As Long, n As Long, ni As Long
Dim AcroApp As New Acrobat.AcroApp, PartDocs() As Acrobat.CAcroPDDoc

a = Split(MyFiles, ",")
ReDim PartDocs(0 To UBound(a))

On Error GoTo exit_
If Len(dir(DestFile)) Then Kill DestFile
For i = 0 To UBound(a)
' Check PDF file presence
If dir(Trim(a(i))) = "" Then
MsgBox "File not found" & vbLf & a(i), vbExclamation, "Canceled"
Exit For
End If
' Open PDF document
Set PartDocs(i) = CreateObject("AcroExch.PDDoc")
PartDocs(i).Open Trim(a(i))
If i Then
' Merge PDF to PartDocs(0) document
ni = PartDocs(i).GetNumPages()
If Not PartDocs(0).InsertPages(n - 1, PartDocs(i), 0, ni, True) Then
MsgBox "Cannot insert pages of" & vbLf & a(i), vbExclamation, "Canceled"
End If
' Calc the number of pages in the merged document
n = n + ni
' Release the memory
PartDocs(i).Close
Set PartDocs(i) = Nothing
Else
' Calc the number of pages in PartDocs(0) document
n = PartDocs(0).GetNumPages()
End If
Next

If i > UBound(a) Then
' Save the merged document to DestFile
If Not PartDocs(0).Save(PDSaveFull, DestFile) Then
MsgBox "Cannot save the resulting document" & vbLf & DestFile, vbExclamation, "Canceled"
End If
End If

exit_:

' Inform about error/success
If Err Then
MsgBox Err.Description, vbCritical, "Error #" & Err.Number
ElseIf i > UBound(a) Then
MsgBox "The resulting file was created in:" & vbLf & DestFile, vbInformation, "Done"
End If

' Release the memory
If Not PartDocs(0) Is Nothing Then PartDocs(0).Close
Set PartDocs(0) = Nothing

' Quit Acrobat application
AcroApp.Exit
Set AcroApp = Nothing
End Sub

Terriblarius
10-27-2016, 01:38 PM
Hi Kenneth, Thanks so much for your work here!

I've added:
Set shtdatabase = Sheets("shtdatabase")
Set shtCover = Sheets("shtcover")

Due to an error i was getting where the "objects were not set". These were added after the dimensioning in sub main()

The result is pretty close. However, it's only creating one cover sheet and then merging all of the pdfs in the folder after it.

I need a cover sheet each spec sheet that is marked to be merged. would this be possible?

the ending result would look like (honda cover sheet - honda specsheet - suzuki cover sheet - suzuki spec sheet - kawasaki cover sheet - kawasaki spec sheet - yamaha cover sheet - yamaha spec sheet)

provided that all of the bikes were selected for merge

I have renamed the excel sheets to match your code. the indirects on the coversheet page were repaired as a result.

It also seems that the script is only drawing up coversheet that is selected in the "Current Preview" value regardless if it's selected or not.

Kenneth Hobs
10-27-2016, 04:22 PM
I figured there was more to this than I was seeing.

So what you wanted was to create a two page PDF file I guess. I would also guess that if column A="y" AND the page 2 file exists, then create page 1 (cover) sheet's pdf file and merge with the existing page 2 file.

It is not that difficult. I would still use similar concepts. What I would do though is to change the values of the cells needed for page 1 via a macro loop. I will show you the new Main() but it may need a tweak or two which you should be able to figure out. I will have to make some guesses for cover and merged filenames.

Kenneth Hobs
10-27-2016, 06:25 PM
Regarding the sheet codename versus sheetname, codenames are more reliable though I often use sheetnames (names in the tab). e.g.

With WorkSheets("Database")
'or
'Dim shtCodename as Worksheet
'Set shtCodename = Worksheets("Database")
'or just the codename directly as I just posted
'With shtDatabase
Sheets() can be used most times for the sheetname method as well.

I have not tested this but it should be close. It should be easy to see how it works and how to tweak from the comments.

I changed the merge routine a bit to show success in the Immediate window rather than a MsgBox().

Sub Main()
Dim fn As String, toPath As String, s As String
Dim r As Range, c As Range, j As Long

With shtDatabase
.Calculate 'update E1 and E2 formulas
If Len(dir(.Range("E1").Value2)) = 0 Then
MsgBox "Save this workbook and retry.", vbCritical, "Macro Ending"
Exit Sub
End If

'Make toPath if needed.
If Len(dir(.Range("E2").Value2, vbDirectory)) = 0 Then MkDir .Range("E2").Value2
toPath = .Range("E2").Value2

'Filter column A
.Range("A3:H3").AutoFilter Field:=1, Criteria1:="y"
Set r = .Range("A3:H3").CurrentRegion.SpecialCells(xlCellTypeVisible)
.Range("A3").AutoFilter 'Remove filter.
If r.Rows.Count = 3 Then Exit Sub 'exit if no filtered data found.

Set r = Intersect(r, .Columns("G:G"))
For Each c In r
j = c.Row
If j < 4 Then GoTo NextC

'Add cover sheet data by filtered rows.
shtCover.Range("C34").Value2 = .Range("B" & j).Value2 'Device
shtCover.Range("C38").Value2 = .Range("C" & j).Value2 'Model
shtCover.Range("C45").Value2 = _
"Name: " & .Range("D" & j).Value2 'Manufacturer Name
shtCover.Range("C46").Value2 = _
.Range("E" & j).Value2 'Website

'Make cover pdf file.
fn = toPath & .Range("B" & j).Value2 & " - Cover.pdf"
shtCover.Range("A7:G51").ExportAsFixedFormat xlTypePDF, fn, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False

'Combine cover with existing page 2 pdf.
s = .Range("G" & j).Value2 'Page 2 filename.
If Len(dir(s)) = 0 Then GoTo NextC
s = fn & "," & s 'Comma delimited string for mergepdfs input.
fn = toPath & .Range("B" & j).Value2 & ".pdf" 'Merged pdf filename.
Debug.Print s, fn
'MergePDFs s, fn
NextC:
Next c
End With
End Sub


Sub MergePDFs(MyFiles As String, Optional DestFile As String)
' Reference required: VBE - Tools - References - Acrobat

Dim a As Variant, i As Long, n As Long, ni As Long
Dim AcroApp As New Acrobat.AcroApp, PartDocs() As Acrobat.CAcroPDDoc

a = Split(MyFiles, ",")
ReDim PartDocs(0 To UBound(a))

On Error GoTo exit_
If Len(dir(DestFile)) Then Kill DestFile
For i = 0 To UBound(a)
' Check PDF file presence
If dir(Trim(a(i))) = "" Then
MsgBox "File not found" & vbLf & a(i), vbExclamation, "Canceled"
Exit For
End If
' Open PDF document
Set PartDocs(i) = CreateObject("AcroExch.PDDoc")
PartDocs(i).Open Trim(a(i))
If i Then
' Merge PDF to PartDocs(0) document
ni = PartDocs(i).GetNumPages()
If Not PartDocs(0).InsertPages(n - 1, PartDocs(i), 0, ni, True) Then
MsgBox "Cannot insert pages of" & vbLf & a(i), vbExclamation, "Canceled"
End If
' Calc the number of pages in the merged document
n = n + ni
' Release the memory
PartDocs(i).Close
Set PartDocs(i) = Nothing
Else
' Calc the number of pages in PartDocs(0) document
n = PartDocs(0).GetNumPages()
End If
Next

If i > UBound(a) Then
' Save the merged document to DestFile
If Not PartDocs(0).Save(PDSaveFull, DestFile) Then
MsgBox "Cannot save the resulting document" & vbLf & DestFile, vbExclamation, "Canceled"
End If
End If

exit_:

' Inform about error/success
If Err Then
MsgBox Err.Description, vbCritical, "Error #" & Err.Number
ElseIf i > UBound(a) Then
Debug.Print "The resulting file was created in:" & vbLf & DestFile, vbInformation, "Done"
End If

' Release the memory
If Not PartDocs(0) Is Nothing Then PartDocs(0).Close
Set PartDocs(0) = Nothing

' Quit Acrobat application
AcroApp.Exit
Set AcroApp = Nothing
End Sub

Terriblarius
10-29-2016, 11:06 PM
I have managed to get this project working exactly the way I want it to. I couldn't have done it without your help Kenneth. With some small tweaks to the code you developed and incorporation of more code found in the forum, I have exactly what I want.

Thank you very much Ken! I'll post the end code either tomorrow or Monday.

Happy Halloween ��

ELANGOVAN
09-03-2017, 09:44 AM
Hello, i have same problem. But my knowledge on VBA is zero :( . I have some PDF in folder "SET A" and i have some PDF in folder "SET B" both files in set A and B have same file name. Now i need to merge both files based on same file names and same in another folder say SET C with same file name. I am using Adobe Acrobat XI Pro. Thanks in advance, please help me.

Kenneth Hobs
09-03-2017, 09:59 AM
Welcome to the forum! This must be a Halloween need?

I am not sure I know just what you mean. If you mean merge 3 files, maybe:

Sub Main()
MergePDFs "c:\pdf\SET A\ken.pdf,c:\pdf\SET B\ken.pdf,c:\pdf\SET C\ken.pdf", "c:\temp\ken.pdf"
End Sub

ELANGOVAN
09-03-2017, 09:16 PM
Thank you sir, for your response. But requirement is not merging only 3 pdf's. I have 300 pdf's in 2 different folders, and i want to merge pdf files having same name. For example I have 300 Cover sheets(PDF) in Folder"SET A" and the datasheets(PDF) in "SET B". Both folders will have each 300 pdf's which is of same file names. Currently am manually inserting cover pages to each datasheet which has same file names. Now i wanted to automate it, excel should pick of same name from both folder and merge them and save them in a different folder.

Set A folder contains(Cover sheets)
45PCV-16.pdf
54FCV-89.pdf
60LCV-90.pdf

Set B folder contains(Data sheets)
45PCV-16.pdf
54FCV-89.pdf
60LCV-90.pdf

Kenneth Hobs
09-04-2017, 09:03 AM
Be sure to add references commented in the code and replace paths in p1, p2, and p3.


'Early Binding method for fso and d requires Reference: MicroSoft Scripting Runtime, scrrun.dll
Sub Main()
Dim p1 As String, p2 As String, p3 As String, f As String
Dim d As New Dictionary, e, fso As New FileSystemObject
Dim a(), b()

'*** Set folder paths to suit ***
p1 = "C:\Users\lenovo1\Dropbox\Excel\pdf\Acrobat\Sets\Set A\" 'Cover sheet PDFs
p2 = "C:\Users\lenovo1\Dropbox\Excel\pdf\Acrobat\Sets\Set B\" 'Matching deta PDFs
p3 = "C:\Users\lenovo1\Dropbox\Excel\pdf\Acrobat\Sets\Set C\ 'Merged PDF folder"


'Get full pdf filenames in folders.
a() = aFFs(p1 & "*.pdf") '& "*.pdf" not needed if only PDFs in p1.
b() = aFFs(p2 & "*.pdf")

'Create dictionay from b() for easy matching scheme.
For Each e In b()
d.Add fso.GetFileName(e), Nothing
Next e

'Iterate each file in p1, match to p1, and merge to p3 if exists in p2.
For Each e In a()
f = fso.GetFileName(e)
If d.Exists(f) Then MergePDFs e & "," & p2 & f, p3 & f
Next e
End Sub

'Command line switches for the shell's Dir, http://ss64.com/nt/dir.html
Function aFFs(myDir As String, Optional extraSwitches = "", _
Optional tfSubFolders As Boolean = False) As Variant

Dim s As String, a() As String, v As Variant
Dim b() As Variant, i As Long

If tfSubFolders Then
s = CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
"""" & myDir & """" & " /b /s " & extraSwitches).StdOut.ReadAll
Else
s = CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
"""" & myDir & """" & " /b " & extraSwitches).StdOut.ReadAll
End If

a() = Split(s, vbCrLf)
If UBound(a) = -1 Then
MsgBox myDir & " not found.", vbCritical, "Macro Ending"
Exit Function
End If
ReDim Preserve a(0 To UBound(a) - 1) As String 'Trim trailing vblfcr

For i = 0 To UBound(a)
If Not tfSubFolders Then
s = Left$(myDir, InStrRev(myDir, "\"))
'add the folder name
a(i) = s & a(i)
End If
Next i
aFFs = sA1dtovA1d(a)
End Function


Function sA1dtovA1d(strArray() As String) As Variant
Dim varArray() As Variant, i As Long
ReDim varArray(LBound(strArray) To UBound(strArray))
For i = LBound(strArray) To UBound(strArray)
varArray(i) = CVar(strArray(i))
Next i
sA1dtovA1d = varArray()
End Function


Sub MergePDFs(MyFiles As String, DestFile As String)
' Reference required: VBE - Tools - References - Acrobat

Dim a As Variant, i As Long, n As Long, ni As Long
Dim AcroApp As New Acrobat.AcroApp, PartDocs() As Acrobat.CAcroPDDoc

a = Split(MyFiles, ",")
ReDim PartDocs(0 To UBound(a))

On Error GoTo exit_
If Len(Dir(DestFile)) Then Kill DestFile
For i = 0 To UBound(a)
' Check PDF file presence
If Dir(Trim(a(i))) = "" Then
MsgBox "File not found" & vbLf & a(i), vbExclamation, "Canceled"
Exit For
End If
' Open PDF document
Set PartDocs(i) = CreateObject("AcroExch.PDDoc")
PartDocs(i).Open Trim(a(i))
If i Then
' Merge PDF to PartDocs(0) document
ni = PartDocs(i).GetNumPages()
If Not PartDocs(0).InsertPages(n - 1, PartDocs(i), 0, ni, True) Then
MsgBox "Cannot insert pages of" & vbLf & a(i), vbExclamation, "Canceled"
End If
' Calc the number of pages in the merged document
n = n + ni
' Release the memory
PartDocs(i).Close
Set PartDocs(i) = Nothing
Else
' Calc the number of pages in PartDocs(0) document
n = PartDocs(0).GetNumPages()
End If
Next

If i > UBound(a) Then
' Save the merged document to DestFile
If Not PartDocs(0).Save(PDSaveFull, DestFile) Then
MsgBox "Cannot save the resulting document" & vbLf & DestFile, vbExclamation, "Canceled"
End If
End If

exit_:

' Inform about error/success
If Err Then
MsgBox Err.Description, vbCritical, "Error #" & Err.Number
ElseIf i > UBound(a) Then
MsgBox "The resulting file was created in:" & vbLf & DestFile, vbInformation, "Done"
End If

' Release the memory
If Not PartDocs(0) Is Nothing Then PartDocs(0).Close
Set PartDocs(0) = Nothing

' Quit Acrobat application
AcroApp.Exit
Set AcroApp = Nothing
End Sub

ELANGOVAN
09-04-2017, 09:41 AM
HI , First Thanks for your help. I have used your code and i have checked Acrobat reference(Tools-Reference-Acrobat) and i have modified the file path, but i am getting an error (compile error: User-defined type not defined). Should i do anything additional ?

ELANGOVAN
09-04-2017, 09:53 AM
'Early Binding method for fso and d requires Reference: MicroSoft Scripting Runtime, scrrun.dllSub Main()
Dim p1 As String, p2 As String, p3 As String, f As String
Dim d As New Dictionary, e, fso As New FileSystemObject
Dim a(), b()

'*** Set folder paths to suit ***
p1 = "F:\New folder\PDF Merge\SET A\" 'Cover sheet PDFs
p2 = "F:\New folder\PDF Merge\SET B\" 'Matching deta PDFs
p3 = "F:\New folder\PDF Merge\SET C\" 'Merged PDF folder'


'Get full pdf filenames in folders.
a() = aFFs(p1 & "*.pdf") '& "*.pdf" not needed if only PDFs in p1.
b() = aFFs(p2 & "*.pdf")

'Create dictionay from b() for easy matching scheme.
For Each e In b()
d.Add fso.GetFileName(e), Nothing
Next e

'Iterate each file in p1, match to p1, and merge to p3 if exists in p2.
For Each e In a()
f = fso.GetFileName(e)
If d.Exists(f) Then MergePDFs e & "," & p2 & f, p3 & f
Next e
End Sub



Function aFFs(myDir As String, Optional extraSwitches = "", _
Optional tfSubFolders As Boolean = False) As Variant

Dim s As String, a() As String, v As Variant
Dim b() As Variant, i As Long

If tfSubFolders Then
s = CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
"""" & myDir & """" & " /b /s " & extraSwitches).StdOut.ReadAll
Else
s = CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
"""" & myDir & """" & " /b " & extraSwitches).StdOut.ReadAll
End If

a() = Split(s, vbCrLf)
If UBound(a) = -1 Then
MsgBox myDir & " not found.", vbCritical, "Macro Ending"
Exit Function
End If
ReDim Preserve a(0 To UBound(a) - 1) As String 'Trim trailing vblfcr

For i = 0 To UBound(a)
If Not tfSubFolders Then
s = Left$(myDir, InStrRev(myDir, "\"))
'add the folder name
a(i) = s & a(i)
End If
Next i
aFFs = sA1dtovA1d(a)
End Function


Function sA1dtovA1d(strArray() As String) As Variant
Dim varArray() As Variant, i As Long
ReDim varArray(LBound(strArray) To UBound(strArray))
For i = LBound(strArray) To UBound(strArray)
varArray(i) = CVar(strArray(i))
Next i
sA1dtovA1d = varArray()
End Function


Sub MergePDFs(MyFiles As String, DestFile As String)
' Reference required: VBE - Tools - References - Acrobat

Dim a As Variant, i As Long, n As Long, ni As Long
Dim AcroApp As New Acrobat.AcroApp, PartDocs() As Acrobat.CAcroPDDoc

a = Split(MyFiles, ",")
ReDim PartDocs(0 To UBound(a))

On Error GoTo exit_
If Len(Dir(DestFile)) Then Kill DestFile
For i = 0 To UBound(a)
' Check PDF file presence
If Dir(Trim(a(i))) = "" Then
MsgBox "File not found" & vbLf & a(i), vbExclamation, "Canceled"
Exit For
End If
' Open PDF document
Set PartDocs(i) = CreateObject("AcroExch.PDDoc")
PartDocs(i).Open Trim(a(i))
If i Then
' Merge PDF to PartDocs(0) document
ni = PartDocs(i).GetNumPages()
If Not PartDocs(0).InsertPages(n - 1, PartDocs(i), 0, ni, True) Then
MsgBox "Cannot insert pages of" & vbLf & a(i), vbExclamation, "Canceled"
End If
' Calc the number of pages in the merged document
n = n + ni
' Release the memory
PartDocs(i).Close
Set PartDocs(i) = Nothing
Else
' Calc the number of pages in PartDocs(0) document
n = PartDocs(0).GetNumPages()
End If
Next

If i > UBound(a) Then
' Save the merged document to DestFile
If Not PartDocs(0).Save(PDSaveFull, DestFile) Then
MsgBox "Cannot save the resulting document" & vbLf & DestFile, vbExclamation, "Canceled"
End If
End If

exit_:

' Inform about error/success
If Err Then
MsgBox Err.Description, vbCritical, "Error #" & Err.Number
ElseIf i > UBound(a) Then
MsgBox "The resulting file was created in:" & vbLf & DestFile, vbInformation, "Done"
End If

' Release the memory
If Not PartDocs(0) Is Nothing Then PartDocs(0).Close
Set PartDocs(0) = Nothing

' Quit Acrobat application
AcroApp.Exit
Set AcroApp = Nothing
End Sub

Kenneth Hobs
09-04-2017, 10:51 AM
'Early Binding method for fso and d requires Reference: MicroSoft Scripting Runtime, scrrun.dll

ELANGOVAN
09-05-2017, 12:01 AM
Hi sir, Thank you am getting it now. You made my life easy. But i need one more help. I get a pop you for every file "Resulting file is created in so and so folder" instead is it possible to make only 1 pop up after all pdf merged?

Kenneth Hobs
09-05-2017, 06:09 AM
I guess you can add your own MsgBox() at the end of Main()?

You can comment out or delete or change MsgBox to Debug.Print in:

MsgBox "The resulting file was created in:" & vbLf & DestFile, vbInformation, "Done"

Debug.Print prints to the Immediate Window in VBE.

For the late vs. early binding issue, see sites like: https://peltiertech.com/Excel/EarlyLateBinding.html
I tend to use more early binding than some since I like to provide more than basic solutions. Itellisense is nice to have for easier coding.