Saltar al contenido

VBA, combina archivos PDF en un archivo PDF

Este tutorial ha sido evaluado por expertos así aseguramos la exactitud de nuestra esta sección.

Solución:

Necesita tener Adobe Acrobat instalado / operativo.

Usé este recurso para referencias de métodos.

https://wwwimages2.adobe.com/content/dam/acom/en/devnet/acrobat/pdfs/iac_api_reference.pdf

EDITAR: intercambiando el array para la lista de vías de acceso a archivos PDF generada automáticamente (en su mayoría, el pdf principal aún configurada por el usuario) que desea insertar en el pdf principal)

Puede usar algo como a continuación para generar la colección de documentos que se insertarán en su documento principal. El primer archivo de la collection sería el file en el que está insertando, igual que en el primer ejemplo. Luego asigne la ruta de la carpeta de la carpeta con el pdf files que le gustaría ver insertado en su documento principal para inputDirectoryToScanForFile. los loop en este código agregará la ruta de cada archivo pdf en esa carpeta a su collection. Estas son las vías que luego se usaron en las llamadas a la API de adobe para insertar archivos PDF en su archivo.

Sub main()

Dim myCol                               As Collection
Dim strFile                             As String
Dim inputDirectoryToScanForFile         As String
Dim primaryFile                         As String

    Set myCol = New Collection

    primaryFile = "C:UsersEvanDesktopmyPDf.Pdf"

    myCol.Add primaryFile

    inputDirectoryToScanForFile = "C:UsersEvanDesktopNew Folder"

    strFile = Dir(inputDirectoryToScanForFile & "*.pdf")

    Do While strFile <> ""
        myCol.Add strFile
        strFile = Dir
    Loop
End Sub

Código que toma un archivo principal e inserta otros archivos PDF en ese archivo:

Sub main()

    Dim arrayFilePaths() As Variant
    Set app = CreateObject("Acroexch.app")

    arrayFilePaths = Array("C:UsersEvanDesktopPAGE1.pdf", _
                            "C:UsersEvanDesktopPAGE2.pdf", _
                            "C:UsersEvanDesktopPAGE3.pdf")

    Set primaryDoc = CreateObject("AcroExch.PDDoc")
    OK = primaryDoc.Open(arrayFilePaths(0))
    Debug.Print "PRIMARY DOC OPENED & PDDOC SET: " & OK

    For arrayIndex = 1 To UBound(arrayFilePaths)
        numPages = primaryDoc.GetNumPages() - 1

        Set sourceDoc = CreateObject("AcroExch.PDDoc")
        OK = sourceDoc.Open(arrayFilePaths(arrayIndex))
        Debug.Print "SOURCE DOC OPENED & PDDOC SET: " & OK

        numberOfPagesToInsert = sourceDoc.GetNumPages

        OK = primaryDoc.InsertPages(numPages, sourceDoc, 0, numberOfPagesToInsert, False)
        Debug.Print "PAGES INSERTED SUCCESSFULLY: " & OK

        OK = primaryDoc.Save(PDSaveFull, arrayFilePaths(0))
        Debug.Print "PRIMARYDOC SAVED PROPERLY: " & OK

        Set sourceDoc = Nothing
    Next arrayIndex

    Set primaryDoc = Nothing
    app.Exit
    Set app = Nothing
    MsgBox "DONE"
End Sub

Este es mi entendimiento de su pregunta:

Requerimientos:

• Combinó una serie de archivos pdf, ubicados en la misma carpeta del libro de trabajo que contiene el procedimiento

• Los nombres de los archivos PDF van desde firstpdf1.pdf para firstpdfn.pdf dónde n es el número total de archivos que se van a combinar

Revisemos su código original:

• Todas las variables deben declararse:

Dim objCAcroPDDocSource as object, objCAcroPDDocDestination as object

• A esta línea le falta el separador de ruta "":

PDFfileName = Dir(ThisWorkbook.Path & "firstpdf" & n & ".pdf")

Debería ser PDFfileName = Dir(ThisWorkbook.Path & "" & "firstpdf" & n & ".pdf")

• Por lo tanto, esta línea siempre regresa "" (no se encontró ningún archivo pdf en el ThisWorkbook.Path):

If PDFfileName <> "" Then

Adicionalmente:

• Estas líneas habrían regresado: Error - 424 Object required como los objetos objCAcroPDDocSource y objCAcroPDDocDestination no se inicializaron:

objCAcroPDDocSource.Open ThisWorkbook.Path & "pathwithpdfs" & PDFfileName

If objCAcroPDDocDestination.InsertPages(objCAcroPDDocDestination.GetNumPages - 1, objCAcroPDDocSource, 0, objCAcroPDDocSource.GetNumPages, 0) Then

objCAcroPDDocSource.Close

• Los objCAcroPDDocDestination nunca se abrió.

Soluciones:Estos procedimientos utilizan la biblioteca de Adobe Acrobat.

Biblioteca de Adobe Acrobat: encuadernación anticipada

Para crear la referencia de Vb a la biblioteca de Adobe en el menú del editor de VBA, haga clic en Tools`Referenciasthen select theBiblioteca de Adobe Acrobatin the dialog window then press theBotón OK`.

Sub PDFs_Combine_EarlyBound()
Dim PdfDst As AcroPDDoc, PdfSrc As AcroPDDoc
Dim sPdfComb As String, sPdf As String
Dim b As Byte

    Rem Set Combined Pdf filename - save the combined pdf in a new file in order to preserve original pdfs
    sPdfComb = ThisWorkbook.Path & "" & "Pdf Combined" & Format(Now, " mmdd_hhmm ") & ".pdf"   'change as required

    Rem Open Destination Pdf
    b = 1
    sPdf = ThisWorkbook.Path & "" & "firstpdf" & b & ".pdf"
    Set PdfDst = New AcroPDDoc
    If Not (PdfDst.Open(sPdf)) Then
        MsgBox "Error opening destination pdf:" & vbCrLf _
            & vbCrLf & "[" & sPdf & "]" & vbCrLf _
            & vbCrLf & vbTab & "Procees will be cancelled!", vbCritical
        Exit Sub
    End If

    Do

        Rem Set & Validate Source Pdf
        b = b + 1
        sPdf = ThisWorkbook.Path & "" & "firstpdf" & b & ".pdf"
        If Dir(sPdf, vbArchive) = vbNullString Then Exit Do

        Rem Open Source Pdf
        Set PdfSrc = New AcroPDDoc
        If Not (PdfSrc.Open(sPdf)) Then
            MsgBox "Error opening source pdf:" & vbCrLf _
                & vbCrLf & "[" & sPdf & "]" & vbCrLf _
                & vbCrLf & vbTab & "Procees will be cancelled!", vbCritical
            GoTo Exit_Sub
        End If

        With PdfDst

            Rem Insert Source Pdf pages
            If Not (.InsertPages(-1 + .GetNumPages, PdfSrc, 0, PdfSrc.GetNumPages, 0)) Then
                MsgBox "Error inserting source pdf:" & vbCrLf _
                    & vbCrLf & "[" & sPdf & "]" & vbCrLf _
                    & vbCrLf & vbTab & "Procees will be cancelled!", vbCritical
                GoTo Exit_Sub
            End If

            Rem Save Combined Pdf
            If Not (.Save(PDSaveFull, sPdfComb)) Then
                MsgBox "Error saving combined pdf:" & vbCrLf _
                    & vbCrLf & "[" & sPdfComb & "]" & vbCrLf _
                    & vbCrLf & vbTab & "Procees will be cancelled!", vbCritical
                GoTo Exit_Sub
            End If

            PdfSrc.Close
            Set PdfSrc = Nothing

        End With

'        sPdf = Dir(sPdf, vbArchive)
'    Loop While sPdf <> vbNullString
    Loop

    MsgBox "Pdf files combined successfully!", vbExclamation

Exit_Sub:
    PdfDst.Close

   End Sub

Biblioteca de Adobe Acrobat: encuadernación tardía

No es necesario crear la referencia Vb a la biblioteca de Adobe

Sub PDFs_Combine_LateBound()
Dim PdfDst As Object, PdfSrc As Object
Dim sPdfComb As String, sPdf As String
Dim b As Byte

    Rem Set Combined Pdf filename - save the combined pdf in a new file in order to preserve original pdfs
    sPdfComb = ThisWorkbook.Path & "" & "Pdf Combined" & Format(Now, " mmdd_hhmm ") & ".pdf"   'change as required

    Rem Open Destination Pdf
    b = 1
    sPdf = ThisWorkbook.Path & "" & "firstpdf" & b & ".pdf"
    Set PdfDst = CreateObject("AcroExch.PDDoc")
    If Not (PdfDst.Open(sPdf)) Then
        MsgBox "Error opening destination pdf:" & vbCrLf _
            & vbCrLf & "[" & sPdf & "]" & vbCrLf _
            & vbCrLf & vbTab & "Procees will be cancelled!", vbCritical
        Exit Sub
    End If

    Do

        Rem Set & Validate Source filename
        b = b + 1
        sPdf = ThisWorkbook.Path & "" & "firstpdf" & b & ".pdf"
        If Dir(sPdf, vbArchive) = vbNullString Then Exit Do

        Rem Open Source filename
        Set PdfSrc = CreateObject("AcroExch.PDDoc")
        If Not (PdfSrc.Open(sPdf)) Then
            MsgBox "Error opening source pdf:" & vbCrLf _
                & vbCrLf & "[" & sPdf & "]" & vbCrLf _
                & vbCrLf & vbTab & "Procees will be cancelled!", vbCritical
            GoTo Exit_Sub
        End If

        With PdfDst

            Rem Insert Source filename pages
            If Not (.InsertPages(-1 + .GetNumPages, PdfSrc, 0, PdfSrc.GetNumPages, 0)) Then
                MsgBox "Error inserting source pdf:" & vbCrLf _
                    & vbCrLf & "[" & sPdf & "]" & vbCrLf _
                    & vbCrLf & vbTab & "Procees will be cancelled!", vbCritical
                GoTo Exit_Sub
            End If

            Rem Save Combined Pdf
            If Not (.Save(1, sPdfComb)) Then
                MsgBox "Error saving combined pdf:" & vbCrLf _
                    & vbCrLf & "[" & sPdfComb & "]" & vbCrLf _
                    & vbCrLf & vbTab & "Procees will be cancelled!", vbCritical
                GoTo Exit_Sub
            End If

            PdfSrc.Close
            Set PdfSrc = Nothing

        End With

'        sPdf = Dir(sPdf, vbArchive)
'    Loop While sPdf <> vbNullString
    Loop

    MsgBox "Pdf files combined successfully!", vbExclamation

Exit_Sub:
    PdfDst.Close

   End Sub

Si para ti ha resultado provechoso este artículo, agradeceríamos que lo compartas con más seniors de este modo contrubuyes a extender esta información.

¡Haz clic para puntuar esta entrada!
(Votos: 0 Promedio: 0)


Tags : / /

Utiliza Nuestro Buscador

Deja una respuesta

Tu dirección de correo electrónico no será publicada. Los campos obligatorios están marcados con *