PDF Dateien mit pdftk zusammenführen

Hallo zusammen,
ich habe folgendes Problem.
Um ein Kostenantragsformular zu erstellen möchte ich verschiedene pdf Dateien zusammenführen.
Die Antragsseite wird in Excel erstellt. Anschließend sollen die einzelnen Angebote mit dem Antrag zusammengeführt werden.
Die Angebote hole ich mir über den Dateipfad in mein Excel. Hier sollen sie ausgelesen und über pdftk zusammengestellt und als Mail verschickt werden.
Jetzt klappt aber leider das zusammenführen nicht richtig. Ich bekomme immer nur die Antragsdatei ohne Anhang ausgegeben.
Hier mein Code:
Option Explicit


Sub drucken()
' Antragsnummer +1
Tabelle1.Range("D12") = Tabelle1.Range("D12") + 1
' Dokument drucken
'Tabelle1.Range("B2:J39").PrintOut
'Als Pdf speichern
Tabelle1.Range("B2:J39").ExportAsFixedFormat xlTypePDF, Filename:="P:\Einkauf\Kostenantragsformulare\Kostenantragsformular HL\Kostenantragsformular HL" & Cells(12, 4) & ".pdf", Openafterpublish:=False
Call DateiZusammenführen
'Dokument leeren
Tabelle1.Range("C17:J30") = ""
End Sub


Sub DateiZusammenführen()
Const Kostenstelle As String = "HL"
Const Quellordner As String = "P:\Einkauf\Kostenantragsformulare\Kostenantragsformular " & Kostenstelle & "\"
Dim Zieldatei As String
Dim PfadGesamt As String
Dim PfadAngebot() As String
Dim i As Integer
Dim a As Integer
Dim objOutlook As Object, objMail As Object
Dim Antrag As String
Antrag = Quellordner & Zieldatei
Zieldatei = "Kostenantragsformular " & Kostenstelle & Cells(12, 4) & ".pdf"
'Anzahl der Pfade speichern
For a = 1 To Cells(Rows.Count, 11).End(xlUp).Row - 17
Next a
'Anzahl Pfade
ReDim PfadAngebot(a - 1)
'Anzahl Pfade Speichern
For i = 0 To UBound(PfadAngebot)
If Cells(i + 17, 11) = "" Then
GoTo Weiterspringen
Else
PfadAngebot(i) = Cells(i + 17, 11).Value
End If
'Pfad(i).PrintOut
Next i
Weiterspringen:
'Pfade Verbinden
PfadGesamt = join(PfadAngebot, " ") 'Antrag & " " &
'    Range("A1") = PfadGesamt
If PfadGesamt = " " Then
Call MsgBox("Keine Dateien gefunden.", vbExclamation, "Hinweis")
Else
'Dateien zusammenführen
'PDFtk
Call Shell(PathName:="C:\Program Files (x86)\PDFtk\bin\pdftk.exe " & _
PfadGesamt & "cat output" & Chr$(34) & Quellordner & Zieldatei & Chr$(34), WindowStyle:=vbNormalFocus)
Call Application.Wait(Time:=Now + TimeSerial(0, 0, 3))
'An Email Anhängen
Set objOutlook = CreateObject(Class:="Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = "info@info.de"
.cc = ""
.Subject = "Kostenantrag " & Kostenstelle & Cells(12, 4)
.Body = "Hallo," & vbLf & vbLf & "im Anhang der Kostenantrag " & Kostenstelle & Cells(12, 4) & "." & _
vbLf & vbLf & "Gruß" & vbLf & Cells(35, 4)
Call .Attachments.Add(Quellordner & Zieldatei)
Call .Display
End With
Set objMail = Nothing
Set objOutlook = Nothing
End If
End Sub

Hier auch die Datei:
https://www.herber.de/bbs/user/146041.xlsm
Ich vermute mal, dass im Shell der Fehler liegt. Komm aber grad nicht drauf.
Ich wäre sehr über eure Hilfe dankbar! Wenn ihr noch mehr Infos braucht, immer gerne melden.
Viele Grüße
Dominik

Hallo zusammen,
jetzt klappt es!
hier nochmal der komplette Code:


Sub DateiZusammenführen()
Const Kostenstelle As String = "HL"
Const Quellordner As String = "P:\Einkauf\Kostenantragsformulare\Kostenantragsformular_" & Kostenstelle & "\"
Dim Zieldatei As String
Dim PfadGesamt As String
Dim PfadAngebot() As String
Dim i As Integer
Dim a As Integer
Dim objOutlook As Object, objMail As Object
Dim Antrag As String
Zieldatei = "Kostenantragsformular_" & Kostenstelle & Cells(12, 4) & ".pdf"
Antrag = Quellordner & Zieldatei
'Anzahl der Pfade speichern
For a = 1 To Cells(Rows.Count, 11).End(xlUp).Row - 17
Next a
'Anzahl Pfade
ReDim PfadAngebot(a - 1)
'Anzahl Pfade Speichern
For i = 0 To UBound(PfadAngebot)
If Cells(i + 17, 11) = "" Then
GoTo Weiterspringen
Else
PfadAngebot(i) = Chr(34) & Cells(i + 17, 11) & Chr(34)
End If
'Pfad(i).PrintOut
Next i
Weiterspringen:
'Pfade Verbinden
PfadGesamt = Chr(34) & Antrag & Chr(34) & " " & join(PfadAngebot, " ")
'    Range("A1") = PfadGesamt
If PfadGesamt = " " Then
Call MsgBox("Keine Dateien gefunden.", vbExclamation, "Hinweis")
Else
'Dateien zusammenführen
'PDFtk
Call Shell(PathName:="C:\Program Files (x86)\PDFtk\bin\pdftk.exe " & _
PfadGesamt & " cat output " & Quellordner & "Zusammenfassung_" & Zieldatei, WindowStyle:=vbMaximizedFocus)
Call Application.Wait(Time:=Now + TimeSerial(0, 0, 3))
'An Email Anhängen
Set objOutlook = CreateObject(Class:="Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = ""
.cc = ""
.Subject = "Kostenantrag " & Kostenstelle & Cells(12, 4)
.Body = "Hallo," & vbLf & vbLf & "im Anhang der Kostenantrag " & Kostenstelle & Cells(12, 4) & "." & _
vbLf & vbLf & "Gruß" & vbLf & Cells(35, 4)
Call .Attachments.Add(Quellordner & Zieldatei)
Call .Display
End With
Set objMail = Nothing
Set objOutlook = Nothing
End If
End Sub

Es gab auch noch ein Problem mit der Variable "Zieldatei". Eigentlich ist das die Exceldatei, die ich am Anfang in ein Pdf umwandle und dann mit den entsprechenden Pfaden verbinden will. Allerdings kann er das pdf im Shell dann nicht einfach überschreiben. Deshalb hab ich da einfach noch das "Zusammenfassung_" eingefügt. So funktioniert es auf jeden Fall!
Vielen Dank für eure Mühen.
Liebe Grüße
Dominik

PDF Dateien mit pdftk zusammenführen

Forumthread: PDF Dateien mit pdftk zusammenführen

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Infobox / Tutorial