Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro um PDF-Dateien in einem Ordner zu mergen

Makro um PDF-Dateien in einem Ordner zu mergen
11.01.2019 12:32:41
Malte
Hallo Forum,
ich stehe gerade vor folgendem Problem:
Ich erstelle im Rahmen mehrerer Projekte aus unterschiedlichsten Programmen einzelne PDF-Dateien, die alle im gleichen Ordner abgespeichert werden. Wenn das Projekt abgeschlossen ist, füge ich derzeit alle PDF-Dateien händisch in Adobe Acrobat zusammen. Gibt es eine Lösung, diese Aufgabe automatisch über VBA-Code zu realisieren?
Also z.B. mit Hilfe eines Buttons in einer Arbeitsmappe alle PDF Dateien im gleichen Verzeichnis zusammenzuführen?
Vielen Dank für eure Tipps!
Gruß Malte

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro um PDF-Dateien in einem Ordner zu mergen
11.01.2019 12:48:24
onur
https://stackoverflow.com/questions/52059078/merging-all-pdf-files-in-a-folder-using-excel-vba
AW: Makro um PDF-Dateien in einem Ordner zu mergen
11.01.2019 13:21:01
Malte
Hallo onur,
vielen Dank für deinen Link! Der Code funktioniert prima!
Ich habe ihn jetzt auf meine Situation angepasst.
Momentan werden die PDF-Dateien, die zusammengesetzt werden sollen noch als Konstante definiert.
Könnte jemand den Code so anpassen, dass alle PDF Dateien in einem Ordner zusammengefasst werden?

Sub MergePDFs()
'Verweis zu Acrobat muss zuerst aktiviert werden!
'VBA-Editor ->Extras - Verweise - Acrobat
'Variablen deklarieren
Dim a As Variant, i As Long, n As Long, ni As Long, p As String
Dim AcroApp As New Acrobat.AcroApp, PartDocs() As Acrobat.CAcroPDDoc
'Pfade -> bei Bedarf anpassen
Const str_pfad = "C:\Users\Anwender\Desktop\PDF\PDF"        'Pfad des Ordners mit den  _
Ausgangsdateien
Const str_Ausgangsdateien = "1.pdf,2.pdf,3.pdf"             'Dateinamen der Dateien, die  _
zusammengeführt werden sollen
Const str_Ergebnisdatei = "PDFneu.pdf"                      'Dateiname der neuen Datei, die  _
ausgegeben wird
'Überprüfen ob str_Pfad mit einem - \ - abschließt
If Right(str_pfad, 1) = "\" Then p = str_pfad Else p = str_pfad & "\"
a = Split(str_Ausgangsdateien, ",")
ReDim PartDocs(0 To UBound(a))
On Error GoTo ende
If Len(Dir(p & str_Ergebnisdatei)) Then Kill p & str_Ergebnisdatei
For i = 0 To UBound(a)
'Überprüfen ob die Datei vorhanden ist
If Dir(p & Trim(a(i))) = "" Then
MsgBox "Datei wurde nicht gefunden!" & vbLf & p & a(i), vbExclamation, "Abgebrochen"
Exit For
End If
'PDF-Datei öffnen
Set PartDocs(i) = CreateObject("AcroExch.PDDoc")
PartDocs(i).Open p & Trim(a(i))
If i Then
'PDF zu PartDocs(0) hinzufügen
ni = PartDocs(i).GetNumPages()
If Not PartDocs(0).InsertPages(n - 1, PartDocs(i), 0, ni, True) Then
MsgBox "Die Seiten aus der folgenden Dateie konnten nicht eingefügt werden:" & vbLf & p & a(i),  _
vbExclamation, "Abgebrochen"
End If
'Seitenzahl im neuen Dokument berechnen
n = n + ni
'Speicher leeren
PartDocs(i).Close
Set PartDocs(i) = Nothing
Else
'Seitenzahl in temporärer Datei - PartDocs(0) - ermitteln
n = PartDocs(0).GetNumPages()
End If
Next
If i > UBound(a) Then
'Die neue Datei im angegebenen Pfad speichern
If Not PartDocs(0).Save(PDSaveFull, p & str_Ergebnisdatei) Then
MsgBox "Konnte die neue zusammengesetzte Datei nicht speichern" & vbLf & p & str_Ergebnisdatei,  _
vbExclamation, "Abgebrochen"
End If
End If
ende:
'Fehler/Erfolg per Messagebox melden
If Err Then
MsgBox Err.Description, vbCritical, "Error #" & Err.Number
ElseIf i > UBound(a) Then
MsgBox "Die zusammengesetzte Datei wurde erstellt:" & vbLf & p & str_Ergebnisdatei,  _
vbInformation, "Fertig"
End If
'Release the memory
If Not PartDocs(0) Is Nothing Then PartDocs(0).Close
Set PartDocs(0) = Nothing
'Acrobat Applikation schließen
AcroApp.Exit
Set AcroApp = Nothing
End Sub

Anzeige
AW: Makro um PDF-Dateien in einem Ordner zu mergen
11.01.2019 13:23:21
onur
"Momentan werden die PDF-Dateien, die zusammengesetzt werden sollen noch als Konstante definiert" -
Du meinst wohl den Pfad - oder?
AW: Makro um PDF-Dateien in einem Ordner zu mergen
11.01.2019 13:26:29
Malte
Momentan werden die 3 Dateien aus dieser Zeile zusammengefügt:
Const str_Ausgangsdateien = "1.pdf,2.pdf,3.pdf"
Ich möchte aber, dass alle Dateien, die in einem Unterordner der Arbeitsmappe liegen zu einer Datei zusammengefügt werden und nicht nur die drei, die explizit angegeben sind.
AW: Makro um PDF-Dateien in einem Ordner zu mergen
11.01.2019 13:49:37
UweD
Hallo
Sub MergePDFs()
    'Verweis zu Acrobat muss zuerst aktiviert werden! 
    'VBA-Editor ->Extras - Verweise - Acrobat 
    
    'Variablen deklarieren 
    Dim a As Variant, i As Long, n As Long, ni As Long, p As String
    Dim AcroApp As New Acrobat.AcroApp, PartDocs() As Acrobat.CAcroPDDoc
    Dim str_Ausgangsdateien As String, strDatei As String
    
    'Pfade -> bei Bedarf anpassen 
    Const str_pfad = "C:\Users\Anwender\Desktop\PDF\PDF"       'Pfad des Ordners mit den zusammengeführt werden sollen 
    Const str_Ergebnisdatei = "PDFneu.pdf"                      'Dateiname der neuen Datei, die ausgegeben wird 
    
    'Überprüfen ob str_Pfad mit einem - \ - abschließt 
    If Right(str_pfad, 1) = "\" Then p = str_pfad Else p = str_pfad & "\"
    
    'Ausgangsdateien zusammenstellen 
    strDatei = Dir(p & "*pdf")
    Do While Len(strDatei) > 0
        str_Ausgangsdateien = str_Ausgangsdateien & "," & strDatei
        strDatei = Dir() ' nächste Datei 
    Loop
    If str_Ausgangsdateien = "" Then
        MsgBox "Keine Dateien gefunden"
        Exit Sub
    End If
     
    a = Split(Mid(str_Ausgangsdateien, 2), ",") 'erstes Komma abschneiden 
    Redim PartDocs(0 To Ubound(a))
    
    On Error GoTo ende

usw...
LG UweD
Anzeige
AW: Makro um PDF-Dateien in einem Ordner zu mergen
11.01.2019 14:03:54
Malte
Hallo UweD,
vielen Dank für deine Anpassungen! Funktioniert wunderbar!
Gruß Malte
Danke für die Rückmeldung owT
11.01.2019 14:15:10
UweD
AW: Makro um PDF-Dateien in einem Ordner zu mergen
11.01.2019 14:21:56
onur
Diese Routine ersetzt das Array durch ein Array aller Pdfs im Ordner, must du in den Code passend einbauen.
Ich kann es leider nicht, weil ich kein Adobe Acrobat habe.
Dim a, Dateiname
Dateiname = Dir$("d:\*.pdf*") 'Hier Verzeichnis und Datei angeben
Do While Dateiname  ""
Dateiname = Dir$()
If a  "" Then
a = a + "=" + Dateiname
Else
a = Dateiname
End If
Loop
a = Split(a, "=")

7 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige