PDF-Sammelmappe per VBA splitten

Guten Morgen,

ich suche schon seit längerem nach einer Möglichkeit, eine mehrseitige Sammelmappe (>50 Seiten) in einzelne PDF zu speichern und dies als VBA.
Wenn jemand eine Idee hätte, wäre ich dankbar über Hilfe und Anregungen, Google konnte mir bisher nicht weiter helfen.

Auch wäre interessant das Gegenteil durchzuführen, also diverse PDF mithilfe von VBA zu einer Sammelmappe zusammenzufassen.

Ich bedanke mich im voraus für eure Hilfe!

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 516651

Url: https://administrator.de/contentid/516651

Ausgedruckt am: 25.11.2024 um 04:11 Uhr

5 Kommentare

Neuester Kommentar

Moin,

Schau Dir mal pdftk an.
Das kannst Du über VBA aufrufen.

Es geht per OCX auch direkt mit dem Acrobat-Reader, aber viel aufwendiger.

https://www.pdflabs.com/tools/pdftk-server/

Stefan

Moin,

so vllt: https://it-muecke.de/node/711
Direkt VBA wird wahrscheinlich enorm aufwendig, es ist sinnvoller ein Programm zu finden, dass du mit Parametern aus dem VBA aufrufen kannst.

Grüße

Vielen Dank für die Anregungen! Leider habe ich nicht die Möglichkeit andere Programme zu installieren und hatte deswegen auf eine halbwegs umsetzbare Lösung gehofft. Trotzdem Danke

Servus again @TeeKanne,

ich suche schon seit längerem nach einer Möglichkeit, eine mehrseitige Sammelmappe (>50 Seiten) in einzelne PDF zu speichern und dies als VBA.

ist eine Kleinigkeit mit dem Acrobat-COM-Object, das bietet ja schon die entsprechende Methode extractPages() dafür an

.
(Quell- und Ziel-Ordner in den Konstanten im Kopf anpassen.)

' ============================================================  
' Aufsplitten von allen PDFs eines Ordners in einzelne Seiten  
' ============================================================  
' Quellordner  
Const FOLDER_IN = "D:\quelle"  
' Ausgabeordner  
Const FOLDER_OUT = "D:\ziel"  

' create objects  
Set objAcro = CreateObject("AcroExch.App")  
Set fso = CreateObject("Scripting.FileSystemObject")   

'  Sicherheitsabfrage  
If MsgBox("Der folgende Prozess findet im Hintergrund statt. Dies kann etwas dauern, bitte haben sie etwas Geduld." & vbNewline & vbNewline & "Sollen wir starten?",vbInformation Or vbSystemModal or vbYesNo,"Split PDFs") = vbNo then wscript.quit  

' Ausgabeordner erstellen wenn er noch nicht existiert  
If Not fso.FolderExists(FOLDER_OUT) Then fso.CreateFolder FOLDER_OUT

' Für jedes File im Quellordner  
For Each file In fso.GetFolder(FOLDER_IN).Files
	' wenn es eine *.pdf Erweiterung hat  
	If LCase(fso.GetExtensionName(file.Name)) = "pdf" Then  
		' Acrobat Objekte erstellen  
		Set docAV = CreateObject("AcroExch.AVDoc")  
		Set docPD = CreateObject("AcroExch.PDDoc")  
		' PDF öffnen  
		docAV.Open file.Path,""  
		
		' Document Object holen  
		Set docPD = docAV.GetPDDoc()
		Set jsDoc = docPD.GetJSObject()
		' Alle Seiten des PDFs verarbeiten  
		For p = 0 To jsDoc.numPages - 1
			' Ausgabepfad zusammensetzen  
			strFileOut = FOLDER_OUT & "\" & fso.GetBaseName(file.Name) & "_" & Right("00" & p+1,3) & ".pdf"  
			' aktuelle Seite extrahieren und speichern  
			jsDoc.extractPages p,p,strFileOut
		Next
		' Document schließen  
		jsDoc.closeDoc()
		'cleanup  
		Set jsDoc = Nothing
		Set docAV = Nothing
		Set docPD = Nothing
	End If
Next
' Acrobat schließen  
objAcro.Exit()

MsgBox "Verarbeitung abgeschlossen!",vbInformation  
' cleanup  
Set fso = Nothing
Set objAcro = Nothing

Code zum Mergen von PDFs gerne gegen Aufwand per PN

-edit- zum Zusammenfassen siehe folgenden Post

Grüße Uwe

Als Ergänzung hier noch das Zusammenfassen von mehreren PDFs eines Ordners zu einem einzigen:

' =================================================================  
' Zusammenfassen von allen PDFs eines Ordners in ein einzelnes PDF  
' =================================================================  

' Quellordner  
Const FOLDER_IN = "D:\Quelle"  
' Ausgabeordner  
Const FILE_OUT = "D:\Ziel\merged_document.pdf"  

' create objects  
Set objAcro = CreateObject("AcroExch.App")  
Set fso = CreateObject("Scripting.FileSystemObject")   

' Sicherheitsabfrage  
If MsgBox("Der folgende Prozess findet im Hintergrund statt. Dies kann etwas dauern, bitte haben sie etwas Geduld." & vbNewline & vbNewline & "Sollen wir starten?",vbInformation Or vbSystemModal or vbYesNo,"Split PDFs") = vbNo then wscript.quit  

' Prüfen ob Datei schon existiert  
If fso.FileExists(FILE_OUT) Then
	If MsgBox("Ausgabedatei existiert bereits, möchten sie sie überschreiben?",vbQuestion Or vbYesNo,"Ausgabedatei überschreiben") = vbYes Then  
		fso.DeleteFile FILE_OUT
	Else
		MsgBox "Abbruch.", vbExclamation  
		WScript.Quit
	End If
End If

Set jsDoc = Nothing

' Für jedes File im Quellordner  
For Each file In fso.GetFolder(FOLDER_IN).Files
	' wenn es eine *.pdf Erweiterung hat  
	If LCase(fso.GetExtensionName(file.Name)) = "pdf" Then  
		If Not jsDoc Is Nothing Then
			jsDoc.insertPages (jsDoc.numPages - 1),file.Path
		Else
			' Acrobat Objekte erstellen  
			Set docAV = CreateObject("AcroExch.AVDoc")  
			Set docPD = CreateObject("AcroExch.PDDoc")  
			' PDF öffnen  
			docAV.Open file.Path,""  
			' Document Object holen  
			Set docPD = docAV.GetPDDoc()
			Set jsDoc = docPD.GetJSObject()
		End If
	End If
Next

If Not jsDoc Is Nothing Then
	jsDoc.saveAs FILE_OUT
	jsDoc.closeDoc()
End If

' Acrobat schließen  
objAcro.Exit()

MsgBox "Verarbeitung abgeschlossen!",vbInformation  
' cleanup  
Set jsDoc = Nothing
Set docAV = Nothing
Set docPD = Nothing
Set fso = Nothing
Set objAcro = Nothing