Soru PDF DOSYALARINI BİRLEŞTİRME

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
Herkese merhaba. 2 veya 3 pdf dosyasını excel yardımı ile birleştirip tek pdf dosyası yapacak bir koda ihtiyacım var. ilgilenecek varsa çok sevinirim.
Dosya yolları A ve B sütunlarında olan iki farklı (ve farklı klasörlerde) .pdf dosyasını birleştirip C sütununda ki isim ile yeni bir klasöre kaydetmek istiyorum. Birden fazla sayıda .pdf dosyası için geçerli olacak bir koda ihtiyaç duyuyorum.

"Klasör1" de ki 1a.pdf ile "Klasör2" de ki 1b.pdf dosyalarını birleştirip 1.pdf ismi ile "Birleştirilmiş" klasöre VEYA benim belirleyeceğim konuma kaydedecek.

Alttaki kodlarla birşeyler yapmaya çalıştım olmadı . Bakabilecek var mı?
Kod:
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)
    ' ZVI:2016-12-10 http://www.vbaexpress.com/forum/showthread.php?47310&p=353568&viewfull=1#post353568
  ' Reference required: VBE - Tools - References - Acrobat

  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)
    ' Check PDF file presence
    If Dir(Trim(a(i))) = "" Then
      MsgBox "File not found" & vbLf & a(i), vbExclamation, "Canceled"
      Exit For
    End If
    ' Open PDF document
    Set PartDocs(i) = New Acrobat.AcroPDDoc ' CreateObject("AcroExch.PDDoc")
    PartDocs(i).Open 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 & a(i), vbExclamation, "Canceled"
      End If
       ' Calc the amount of pages in the merged document
      n = n + ni
      ' Release the memory
      PartDocs(i).Close
      Set PartDocs(i) = Nothing
    Else
       ' Calc the amount 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 & 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 & 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
  'DoEvents: DoEvents
  Set AcroApp = Nothing

End Sub
 

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,398
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Kodda adı geçen referansı eklediniz mi?

.
 

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
@Haluk Bey dosyamı ekledim. Ama dediginiz referans olayını anlamadım. Dosyaya bakma imkanınız varsa çok sevinirim.
 

Ekli dosyalar

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,398
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Dosyanızda kod göremedim, ama zaten fark etmez....

Kodun çalışacağı bilgisayarda lisanslı Acrobat Professional yoksa, çalışmaz..... Adobe Reader'dan bahsetmiyorum, bahsettiğim program bir kaç bin $ değerinde bir programdır.

.
 

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
@Haluk Bey ofisimde dediginiz lisanslı acrobat var ve onda birleştirme ayırma vb daha bir çok şeyi yapabiliyorum. Benim istediğim excelde yapabilmek . Ama kodlarda hata yapıyorum.
 

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
@Haluk Bey çok teşekkür ederim.
 
Üst