How to stop at an empty cell while merging PDFs using Excel VBA and Adobe Acrobat library

user_14281523 0
Viewed 83

First of all I'd like to preface this by saying that I have less than a week's experience using VBA.

I have been trying to create a script that merges PDFs that are linked in an Excel sheet. The code that I have works fine, however, when I add multiple tables separated by empty rows, the script will continue to move down through the empty cells and collect the PDFs from the next table as well.

So if I select the bottom table to merge, it will work fine, but if I select the top one, it will merge all the linked PDFs for ALL the tables moving down.

Here is a screenshot of the Excel sheet I have at the moment: Excel Sheet

What I would like is for the script to stop at the first empty cell it encounters while moving down column D, rather than continuing until the last populated cell. Meaning that the script will only merge one table of PDFs.

As I said, this is my first week using any VBA, so I have been struggling to get the range for the PDF merging to end when it encounters the empty cell.

Any help would be greatly appreciated!

Sub Button9_Click()

'References
'Adobe Acrobat 10.0 Type Library


    Dim objCAcroPDDocDestination As Acrobat.CAcroPDDoc
    Dim objCAcroPDDocSource As Acrobat.CAcroPDDoc
    Dim PDFfiles As Range, PDFfile As Range
    Dim n As Long
    Dim em As String

        
    'Set start point of cell range
    'Takes ActiveCell from search results and offsets to filepaths
    
    'CURRENTLY LOOKS FOR LAST POPULATED CELL IN COLUMN, DISREGARDING PREVIOUS EMPTY CELLS
    
        With ActiveSheet
            Set PDFfiles = .Range(ActiveCell.Offset(3, 1), .Cells(.Rows.Count, "D").End(xlUp))
            
        End With
    
    'Create Acrobat API objects
    
        Set objCAcroPDDocDestination = CreateObject("AcroExch.PDDoc")
        Set objCAcroPDDocSource = CreateObject("AcroExch.PDDoc")
    
    'Open first PDF file and merge other PDF files into it
    
        n = 0
        For Each PDFfile In PDFfiles
            n = n + 1
            If n = 1 Then
                objCAcroPDDocDestination.Open PDFfile.Value
            Else
                objCAcroPDDocSource.Open PDFfile.Value
                If Not objCAcroPDDocDestination.InsertPages(objCAcroPDDocDestination.GetNumPages - 1, objCAcroPDDocSource, 0, objCAcroPDDocSource.GetNumPages, 0) Then
                    MsgBox "Error merging" & PDFfile.Value
                End If
                objCAcroPDDocSource.Close
            End If
        Next
        
    
    'Save merged PDF files as a new file
    
        objCAcroPDDocDestination.Save 1, "C:\Users\USER\OneDrive\TEST MERGE\Output\" & Sheets("SEARCH").Range("E6").Value & ".pdf"
        objCAcroPDDocDestination.Close
    
        Set objCAcroPDDocSource = Nothing
        Set objCAcroPDDocDestination = Nothing

    'Opens dialogue box for successful/failed merge
    
        MsgBox "Created New PDF (" & Sheets("SEARCH").Range("E6").Value & ")" & vbCrLf & vbCrLf & "File Path: C:\Users\USER\OneDrive\TEST MERGE\Output\" & Sheets("SEARCH").Range("E6").Value & ".pdf"
    
    'Opens merged PDF
    
        ActiveWorkbook.FollowHyperlink "C:\Users\USER\OneDrive\TEST MERGE\Output\" & Sheets("SEARCH").Range("E6").Value & ".pdf"

    

End Sub
vba excel pdf
1 Answers

Try the next code, please:

Sub MergePDFDocuments()
 'References to 'Adobe Acrobat 10.0 Type Library
    Dim objCAcroPDDocDestination As Acrobat.CAcroPDDoc, objCAcroPDDocSource As Acrobat.CAcroPDDoc, i As Long
    Dim PDFfiles As Range, PDFfile As Range, n As Long, em As String, processArr As String, prRng As Range
    Dim sh As Worksheet, startRow As Long, endRow As Long
    
    Set sh = ActiveSheet 'use here your sheet
    processArr = "A" 'the group files to be processed.
                     'It can be "B", or other letter if the workbook will be filled with other groups
    'CURRENTLY LOOKS FOR LAST POPULATED CELL IN COLUMN, DISREGARDING PREVIOUS EMPTY CELLS
    'Set PDFfiles = sh.Range(sh.Offset(3, 1), sh.cells(rows.count, "D").End(xlUp))
    endRow = sh.cells(rows.count, "D").End(xlUp).row
    For i = 2 To endRow
        If sh.Range("C" & i).value = "PRODUCT " & processArr Then
            startRow = i + 2: Exit For
        End If
    Next i
    If startRow >= i Then MsgBox "Strange..." & vbCrLf & _
                     "The area to be prcessed ""PRODUCT " & processArr & """ could not be found.": Exit Sub
   
    'Create Acrobat API objects
    Set objCAcroPDDocDestination = CreateObject("AcroExch.PDDoc")
    Set objCAcroPDDocSource = CreateObject("AcroExch.PDDoc")
    
    'Open first PDF file and merge other PDF files into it
    For i = startRow To endRow
        n = n + 1
        If sh.Range("D" & i).value = "" Then Exit For 'iteration is interrupted in case of an empty cell in D:D:
        If n = 1 Then
            objCAcroPDDocDestination.Open sh.Range("D" & i).value
        Else
            objCAcroPDDocSource.Open sh.Range("D" & i).value
            If Not objCAcroPDDocDestination.InsertPages(objCAcroPDDocDestination.GetNumPages - 1, _
                                        objCAcroPDDocSource, 0, objCAcroPDDocSource.GetNumPages, 0) Then
                MsgBox "Error merging: " & sh.Range("D" & i).value
            End If
            objCAcroPDDocSource.Close
        End If
    Next i
            
    'Save merged PDF files as a new file. Here the pdf name can be assorted with the area to be processed (for instance PRODUCT A):
    objCAcroPDDocDestination.Save 1, "C:\Users\USER\OneDrive\TEST MERGE\Output\" & Sheets("SEARCH").Range("E6").value & ".pdf"
    objCAcroPDDocDestination.Close
    
    Set objCAcroPDDocSource = Nothing
    Set objCAcroPDDocDestination = Nothing

    'Opens dialogue box for successful/failed merge
    MsgBox "Created New PDF (" & Sheets("SEARCH").Range("E6").value & ")" & vbCrLf & vbCrLf & "File Path: C:\Users\USER\OneDrive\TEST MERGE\Output\" & Sheets("SEARCH").Range("E6").value & ".pdf"
    
    'Opens merged PDF
    ActiveWorkbook.FollowHyperlink "C:\Users\USER\OneDrive\TEST MERGE\Output\" & Sheets("SEARCH").Range("E6").value & ".pdf"
End Sub

You must set processArr to be processed (A or B from your picture).

Code is not tested, but it should work. Please test it and send some feedback.

user_22333080
Related