PDF nach Logik zusammenfügen
10.02.2022 07:34:34
Pascal
ich habe folgendes Problem, vielleicht könnt ihr mir helfen...
Ich habe in einem Ordner X - 1000 PDF-Dateien.
Aus diesen 1000 PDF-Dateien sollen 500 PDF-Dateien werden indem immer jeweils zwei PDFs zu einer zusammengefügt werden.
Diese PDF-Dateien haben im Namen eine Bezeichnung X_XX. (z.B. R_12, R_54, usw. - es gibt immer 2 PDFs mit der gleichen Bezeichnung am Anfang des Dateinamens)
Die PDFs sollen nach dieser Bezeichnung zusammengeführt werden. Also "R_12_xxx.pdf" mit "R_12_yyy.pdf", "R_54_xxx.pdf" mit "R_54_yyy.pdf", usw.
Gibt es eine Möglichkeit das mit einem Makro zu machen? Mit VBA in Excel?
Ich habe dazu folgenden Programmcode in einem anderen Forum gefunden, jedoch weiß ich nicht ob er wirklich passt.
https://www.herber.de/forum/archiv/1692to1696/1692357_Ist_es_moeglich_per_VBA_PDFDateien_zusammenzufuegen.html
Option Explicit
Public Sub Mail_senden()
Const FOLDER_PATH As String = "H:\Bestellungen\"
Dim objOutlook As Object, objMail As Object
Dim strFolder As String, strFileName As String
Dim strAttachments As String, strOrder As String
Dim avntAttachments() As Variant
Dim ialngIndex As Long
Dim dtmDate As Date
dtmDate = Worksheets("Eingabe").Range("G3").Value
strOrder = "Bestellung vom" & Format$(dtmDate, "dd.mm") & ".pdf"
strFolder = FOLDER_PATH & Format$(dtmDate, "yyyy") & _
"\" & Format$(dtmDate, "mmmm") & "\"
strFileName = Dir$(strFolder & "*" & Format$(dtmDate, "dd-mm") & "*.pdf")
Do Until strFileName = vbNullString
Redim Preserve avntAttachments(ialngIndex)
avntAttachments(ialngIndex) = Chr$(34) & strFolder & strFileName & Chr$(34)
ialngIndex = ialngIndex + 1
strFileName = Dir$
Loop
If ialngIndex = 0 Then
Call MsgBox("Keine Dateien gefunden.", vbExclamation, "Hinweis")
Else
strAttachments = Join(avntAttachments, " ")
Call Shell(PathName:="C:\Program Files (x86)\PDFtk\bin\pdftk.exe " & _
strAttachments & " cat output " & FOLDER_PATH & strOrder, WindowStyle:=vbHide) 'Pfad anpassen !!!
Set objOutlook = CreateObject(Class:="Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = "name@provider.de"
.Subject = "Betreff"
.Body = "Hallo" & vbLf & vbLf & "im Anhang die Dateien." & _
vbLf & vbLf & "Gruß" & vbLf & "Sabbel"
Call .Attachments.Add(FOLDER_PATH & strOrder)
Call .Display 'Anzeigen
' Call .Send 'direkt senden
End With
Set objMail = Nothing
Set objOutlook = Nothing
Call Kill(PathName:=FOLDER_PATH & strOrder)
End If
End Sub
Pascal