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

Question

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

15

我正在尝试使用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

- excelguy

1

在Excel VBA中没有内置机制来完成这个操作：我相信你需要一个第三方工具/库。 - Tim Williams

@TimWilliams，这是Acrobat API的代码，它可以执行所有Excel VBA以合并PDF。 - excelguy

1

但是您说您不想使用第三方组件。 - Tim Williams

修正了问题，如果只有这种方法，我可以使用Acrobat API。但不想使用随机插件。 - excelguy

似乎你的第二段代码没有指定路径，而是依赖于当前目录与文件所在目录相同，因此有时会起作用。第一段代码的问题似乎是路径中缺少了“\”：ThisWorkbook.Path & "\filename.pdf"。 - Slai

5个回答

3

这是我对您问题的理解：

需求：

• 将位于包含该过程的工作簿相同文件夹中的一系列pdf文件合并

• Pdf文件名称从firstpdf1.pdf到firstpdfn.pdf，其中n是要合并的文件总数

让我们来看一下您原始代码的情况：

• 所有变量都应声明：

Dim objCAcroPDDocSource as object, objCAcroPDDocDestination as object

• 这行缺少路径分隔符"\"：

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

应该是PDFfileName = Dir(ThisWorkbook.Path & "\" & "firstpdf" & n & ".pdf")

所以此行始终返回""（在ThisWorkbook.Path中找不到pdf文件）：

If PDFfileName <> "" Then

此外：

• 这些行将返回：Error - 424 Object required，因为对象objCAcroPDDocSource和objCAcroPDDocDestination未初始化：

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

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

objCAcroPDDocSource.Close

• objCAcroPDDocDestination从未打开过。

解决方案： 这些程序使用Adobe Acrobat库

Adobe Acrobat库-早期绑定

要在VBA编辑器菜单中创建对Adobe库的Vb引用，请单击Tools`References然后在对话窗口中选择Adobe Acrobat Library，然后按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

Adobe Acrobat Library - Late bound

无需创建对Adobe库的Vb引用。

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

- EEM

1

我创建了两个PDF文件，并使用Open Office将它们合并成一个PDF。该子程序打开LibreDraw，将PDF作为图像插入并导出为PDF。必须关闭绘图才能工作。

    sub MergePDF()

    Dim Doc As Object 'This workbook

    Dim NewWorkBookURL As String

    NewWorkBookURL = "private:factory/sdraw"
 
    Dim noArgs() 'An empty array for the arguments

    Dim Point As New com.sun.star.awt.Point
    Dim Size As New com.sun.star.awt.Size

    Point.x = 0
    Point.y = 0
    'A4
    Size.Width = 21000
    Size.Height = 29700

    Dim Page1 As Object 'Excel sheet
    Dim Page2 As Object 'AutoCAD sheet

    Dim Image1 As Object 'PDF1
    Dim Image2 As Object 'PDF2

    Dim DocPath1 As String
    Dim DocPath2 As String
    Dim DocPath3 As String

    DocPath1 = ConvertToURL("C:\Users\pdf1.pdf")
    DocPath2 = ConvertToURL("C:\Users\pdf2.pdf")
    DocPath3 = ConvertToURL("C:\Users\pdf3.pdf")

    Doc = StarDesktop.LoadComponentFromUrl(NewWorkBookURL, "_blank", 0, noArgs())

    Page1 = Doc.DrawPages(0)
    Page1.Name = "PDF1"

    Page2 = Doc.Drawpages.insertNewByIndex(2)
    Page2.Name = "PDF2"

   'Page 1  
    Image1 = Doc.createInstance("com.sun.star.drawing.GraphicObjectShape")
    Image1.GraphicURL = DocPath1
    
    Image1.Size = Size
    Image1.Position = Point
    Page1.add(Image1)

    'Page 2 
    Image2 = Doc.createInstance("com.sun.star.drawing.GraphicObjectShape")
    Image2.GraphicURL = DocPath2
    
    Image2.Size = Size
    Image2.Position = Point
    Page2.add(Image2)

    'ExportToPDF

    dim args2(2) as new com.sun.star.beans.PropertyValue
    args2(0).Name = "URL"
    args2(0).Value = DocPath3
    args2(1).Name = "FilterName"
    args2(1).Value = "calc_pdf_Export"

    args2(2).Name = "FilterData"
    args2(2).Value = Array(Array("UseLosslessCompression",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("Quality",0,90,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("ReduceImageResolution",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("MaxImageResolution",0,300,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("UseTaggedPDF",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("SelectPdfVersion",0,0,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("ExportNotes",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("ExportBookmarks",0,true,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("OpenBookmarkLevels",0,-1,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("UseTransitionEffects",0,true,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("IsSkipEmptyPages",0,true,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("IsAddStream",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("FormsType",0,0,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("ExportFormFields",0,true,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("HideViewerToolbar",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("HideViewerMenubar",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("HideViewerWindowControls",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("ResizeWindowToInitialPage",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("CenterWindow",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("OpenInFullScreenMode",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("DisplayPDFDocumentTitle",0,true,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("InitialView",0,0,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("Magnification",0,0,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("Zoom",0,100,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("PageLayout",0,0,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("FirstPageOnLeft",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("InitialPage",0,1,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("Printing",0,2,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("Changes",0,4,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("EnableCopyingOfContent",0,true,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("EnableTextAccessForAccessibilityTools",0,true,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("ExportLinksRelativeFsys",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("PDFViewSelection",0,0,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("ConvertOOoTargetToPDFTarget",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("ExportBookmarksToPDFDestination",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("_OkButtonString",0,"",com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("EncryptFile",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("DocumentOpenPassword",0,"",com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("RestrictPermissions",0,false,com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("PermissionPassword",0,"",com.sun.star.beans.PropertyState.DIRECT_VALUE),Array("Selection",0,,com.sun.star.beans.PropertyState.DIRECT_VALUE))

    Doc.storeToURL(DocPath3,args2())


    msgbox "Done"

    End sub

无需 Adobe。

- hemis

0

我从stackoverflow上获取了以下代码，它可以列出文件夹中的所有子文件夹。

Sub FolderNames()
'Update 20141027
Application.ScreenUpdating = False
Dim xPath As String
Dim xWs As Worksheet
Dim fso As Object, j As Long, folder1 As Object
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choose the folder"
.Show
End With
On Error Resume Next
xPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
'Application.Workbooks.Add
Set xWs = Application.ActiveSheet
Sheets("Sheet1").Cells.Clear
xWs.Cells(1, 1).Value = xPath
xWs.Cells(2, 1).Resize(1, 5).Value = Array("Path", "Dir", "Name", "Date Created",            "Date Last Modified")
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder1 = fso.GetFolder(xPath)
getSubFolder folder1
xWs.Cells(2, 1).Resize(1, 5).Interior.Color = 65535
xWs.Cells(2, 1).Resize(1, 5).EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
Sub getSubFolder(ByRef prntfld As Object)
Dim SubFolder As Object
Dim subfld As Object
Dim xRow As Long
For Each SubFolder In prntfld.SubFolders
xRow = Range("A1").End(xlDown).Row + 1
Cells(xRow, 1).Resize(1, 5).Value = Array(SubFolder.Path, Left(SubFolder.Path,       InStrRev(SubFolder.Path, "\")), SubFolder.Name, SubFolder.DateCreated, SubFolder.DateLastModified)
Next SubFolder
For Each subfld In prntfld.SubFolders
getSubFolder subfld
Next subfld
End Sub

这段代码会合并子文件夹中的所有PDF文件，并将输出存储在选择的目标文件夹中。

Sub Merger()
Dim i As Integer
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sheet1")
Dim k As Integer
Dim st As String
Dim na As String
Dim dest As String

With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choose the Destination folder"
.Show
End With
dest = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"


k = sh.Range("A1048576").End(xlUp).Row
For i = 3 To k
st = sh.Cells(i, 1).Value
na = sh.Cells(i, 3).Value
Call Main(st, na, dest)
Next

 MsgBox "The resulting files are created" & vbLf & p & DestFile, vbInformation, "Done"

End Sub

Sub Main(ByVal st As String, ByVal na As String, dest As String)

Dim DestFile As String
DestFile = "" & dest & na & ".pdf" ' <-- change TO Your Required Desitination

Dim MyPath As String, MyFiles As String
Dim a() As String, i As Long, f As String
Dim R As Range
Dim ws As Worksheet
Dim n As Long



 ' Choose the folder or just replace that part by: MyPath = Range("E3")
With Application.FileDialog(msoFileDialogFolderPicker)
     '.InitialFileName = "C:\Temp\"
    .AllowMultiSelect = True
    'If .Show = False Then Exit Sub
    MyPath = st
    DoEvents
End With

  ' Populate the array a() by PDF file names
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
ReDim a(1 To 2 ^ 14)

f = Dir(MyPath & "*")
While Len(f)
    If StrComp(f, DestFile, vbTextCompare) Then
        i = i + 1
        a(i) = f
        'a().Sort
    End If
    f = Dir()
Wend

'排序--------------------------------------------------------

这段内容介绍的是排序。

Set ws = ThisWorkbook.Sheets("Sheet2")

' put the array values on the worksheet
Set R = ws.Range("A1").Resize(UBound(a) - LBound(a) + 1, 1)
R = Application.Transpose(a)

' sort the range
R.Sort key1:=R, order1:=xlAscending, MatchCase:=False

' load the worksheet values back into the array
For n = 1 To R.Range("A1048576").End(xlUp).Row
    a(n) = R(n, 1)
Next n

If i Then
    ReDim Preserve a(1 To i)
    MyFiles = Join(a, ",")
    Application.StatusBar = "Merging, please wait ..."
    Call MergePDFs(MyPath, MyFiles, DestFile)
    Application.StatusBar = False
Else
    MsgBox "No PDF files found in" & vbLf & MyPath, vbExclamation, "Canceled"
End If

End Sub

'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 ' 需要引用：VBE - 工具 - 引用 - Acrobat

Sub MergePDFs(MyPath As String, MyFiles As String, Optional DestFile As String)
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
If Right(MyPath, 1) = "\" Then p = MyPath Else p = MyPath & "\"
a = Split(MyFiles, ",")
ReDim PartDocs(0 To UBound(a))

On Error GoTo exit_
If Len(Dir(DestFile)) Then Kill p & 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 & p & 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 is created:" & 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

- Jagadish N P

0

我没有你的问题的确切解决方案，但是我遇到过类似的问题，即我想从VBA向PDF添加字段。

我可以告诉你，Adobe有一个JavaScript API，你可以通过vba控制它。

这是API的链接https://www.adobe.com/devnet/acrobat/javascript.html

这是我在VBA中使用的一部分代码，用于控制PDF中的字段。

Set app = CreateObject("Acroexch.app")
app.Show
Set AVDoc = CreateObject("AcroExch.AVDoc")
Set AForm = CreateObject("AFormAut.App") 'from AFormAPI
AVDoc.Open(pathsdf, "")

Ex = "Put your JavaScript Code here"

AForm.Fields.ExecuteThisJavaScript Ex

你应该看一下API中的insertPages方法。

另外一个可能的方法是使用VBA到Acrobat内置的引用。然而，我发现这种方法非常有限，我没有用过它。只有几个对象可用，以下是一些示例：

Dim AcroApp As Acrobat.AcroApp
Dim objAcroAVDoc As New Acrobat.AcroAVDoc
Dim objAcroPDDoc As Acrobat.AcroPDDoc
Dim objAcroPDPage As Acrobat.AcroPDPage
Dim annot As Acrobat.AcroPDAnnot

- Franksta

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- learnAsWeGo · Accepted Answer

您需要安装/运行Adobe Acrobat。

我使用了这个资源，关于方法引用。

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

EDIT: 将数组替换为自动生成的（大部分是，主要pdf仍由用户设置）pdf路径列表，您希望将其插入到主pdf中。

您可以使用以下内容生成要插入主文档的文档集合。集合中的第一个文件与第一个示例中相同，是您要插入的file。然后将包含您想要插入到主文档中的pdf files的文件夹路径分配给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