PDF Dosyalarını Birleştirme

Sub Main()
  Dim MyFiles As String, DestFile As String
  With ActiveSheet
    MyFiles = .Range("A1").Value & "," & .Range("B1").Value
    DestFile = .Range("C1").Value
  End With
  Call MergePDFs01(MyFiles, DestFile)
End Sub

Sub MergePDFs01(MyFiles As String, DestFile As String)
  Dim a As Variant, i As Long, n As Long, ni As Long
  Dim AcroApp As New Acrobat.AcroApp, PartDocs() As Acrobat.AcroPDDoc

  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)
    If Dir(Trim(a(i))) = "" Then
MsgBox "File not found" & vbLf & a(i), vbExclamation, "Canceled"
Exit For
    End If
    Set PartDocs(i) = New Acrobat.AcroPDDoc
    PartDocs(i).Open Trim(a(i))
    If i Then
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
n = n + ni
PartDocs(i).Close
Set PartDocs(i) = Nothing
    Else
n = PartDocs(0).GetNumPages()
    End If
  Next

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

exit_:

  If Err Then
    MsgBox Err.Description, vbCritical, "Error #" & Err.Number
  ElseIf i > UBound(a) Then
    MsgBox "The resulting file is created:" & vbLf & DestFile, vbInformation, "Done"
  End If

  If Not PartDocs(0) Is Nothing Then PartDocs(0).Close
  Set PartDocs(0) = Nothing
  AcroApp.Exit
  Set AcroApp = Nothing

End Sub