VBA,将PDF合并为一个PDF文件

Question

我正在尝试使用vba将PDF组合成一个单独的pdf.我想不使用插件工具,并尝试使用下面的acrobat api.

我尝试了类似的东西,但似乎无法让它发挥作用.我没有错误消息,但也许我错过了部分.

任何帮助,将不胜感激.

   Sub Combine()


   Dim n As Long, PDFfileName As String

    n = 1
    Do
        n = n + 1
        PDFfileName = Dir(ThisWorkbook.Path & "firstpdf" & n & ".pdf")
        If PDFfileName <> "" Then
            'Open the source document that will be added to the destination
            objCAcroPDDocSource.Open ThisWorkbook.Path & "pathwithpdfs" & PDFfileName
            If objCAcroPDDocDestination.InsertPages(objCAcroPDDocDestination.GetNumPages - 1, objCAcroPDDocSource, 0, objCAcroPDDocSource.GetNumPages, 0) Then
                MsgBox "Merged " & PDFfileName
            Else
                MsgBox "Error merging " & PDFfileName
            End If
            objCAcroPDDocSource.Close
        End If
    Loop While PDFfileName <> ""


   End Sub

新代码:

新守则:

Sub main()

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

    arrayFilePaths = Array("mypath.pdf", _
                            "mypath2.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

Answer 1

您需要安装/运行 adobe acrobat。

我用这个资源重新方法引用

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

编辑：交换自动生成的数组（主要是仍由用户设置的主要 pdf）要插入到主要 pdf 中的 pdf 路径列表）

您可以使用类似下面的内容来生成要插入到主文档中的文档集合。中的第一个文件collection将是file您要插入的文件，与第一个示例相同。然后将文件夹的文件夹路径分配给files您希望看到的 pdf插入到您的主要文档中inputDirectoryToScanForFile。在loop这个代码将在该文件夹中添加的每个PDF文件的途径，以你的collection。这些是稍后在 adobe API 调用中用于将 pdf 插入到您的主文件中的途径。

Sub main()

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

    Set myCol = New Collection

    primaryFile = "C:\Users\Evan\Desktop\myPDf.Pdf"

    myCol.Add primaryFile

    inputDirectoryToScanForFile = "C:\Users\Evan\Desktop\New Folder\"

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

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

获取主文件并将其他 pdf 插入该文件的代码：

Sub main()

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

    arrayFilePaths = Array("C:\Users\Evan\Desktop\PAGE1.pdf", _
                            "C:\Users\Evan\Desktop\PAGE2.pdf", _
                            "C:\Users\Evan\Desktop\PAGE3.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