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ı?
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