Mit Excel-VBA Dokumenteigenschaften PDF auslesen
23.07.2013 17:58:13
grassshopper
Frage:
wie kann ein 600-Zeichen-Eintrag aus den Dokumenteigenschaften einer PDF-Datei vollständig ausgelesen werden (Problem: String Zeichenbegrenzung)?
Über ein Excel-Formular werden mit Auswahlboxen Daten gewählt, darüber gesteuert ggf. Freitextfelder aktiviert, in die manuell Daten eingetragen werden können. Dies alles wird in ein Sheet übertragen. Dieses Sheet wird über VBA-Code mit PDFCreator als PDF-Dokument gespeichert.
Damit Kollegen mit meinem Excel-Formular bei einigen Dokumenten die Möglichkeit bekommen sollen, das PDF-Dokument nach Excel-Formular "zurückzuladen" und über das Formular zu überarbeiten (und neues PDF-Dokument zu generieren), werden die erfassten Daten in den Dokumenteigenschaften "Stichwörter" gespeichert.
Die erfassten Daten können ca. 600 (bis ca. 1000) Zeichen betragen.
Wenn ich nun das PDF-Dokument öffne (in Adobe Reader), kann ich mit rechter Maustaste die Eigenschaften abfragen und finde in "Stichwörter" auch diese 600 Zeichen wieder.
Hintergrund:
Es sollen nur bestimmte Daten über Auswahlboxen im Formular verwendet werden. In Ausnahmefällen soll das zurückladen möglich sein, damit bei ähnlichen Daten nicht alle Eingaben erneut von Hand gemacht werden müssen, sondern nur im komfortablen Formular einige Änderungen vorgenommen werden können.
Problem:
ich möchte diese Dokumenteigenschaften mit einem separaten VBA-Code in Excel auslesen, bekomme aber bei "Stichwörter" nur 259 Zeichen angezeigt (String).
Weiß jemand, wie ich diese Dokumenteigenschaften per VBA-Code vollständig auslesen kann?
Code zum Zurückladen der Daten:
Sub pdf_Zurueckladen()
Dim strVerzeichnis, strDateiname, strZielPfad, strZielDatei As String
Dim fso As New Scripting.FileSystemObject
Dim datei
Dim objFolder As Object
Dim varName
Dim docAutor, docTitel, docThema, docStichwoerter As Variant
Dim ws As Worksheet
strVerzeichnis = "C:\temp\"
strDateiname = Application.GetOpenFilename(filefilter:="PDF (*.pdf), *.pdf", Title:=" _
Linienmitteilung öffnen")
Select Case strDateiname
Case False: Exit Sub
End Select
Set datei = fso.GetFile(strDateiname)
strZielPfad = Left(strDateiname, InStrRev(strDateiname, "\"))
strZielDatei = Mid(strDateiname, InStrRev(strDateiname, "\") + 1)
Set objFolder = CreateObject("Shell.Application").Namespace(strZielPfad)
For Each varName In objFolder.Items
If varName = strZielDatei Then
docAutor = objFolder.getdetailsof(varName, 9)
docTitel = objFolder.getdetailsof(varName, 10)
docThema = objFolder.getdetailsof(varName, 11)
docStichwoerter = objFolder.getdetailsof(varName, 40)
End If
Next
'"docStichwoerter" wird über Variable "Tr" (Trenn-Kennzeichen) nach und nach verkleinert
If (docTitel = vorgabeDocTitel) And (docThema = vorgabeDocThema) Then
Me.txt_Datum.Value = Left(docStichwoerter, InStr(1, docStichwoerter, Tr) - 1)
docStichwoerter = Mid(docStichwoerter, InStr(1, docStichwoerter, Tr) + 1)
Me.txt_Kunde.Value = Left(docStichwoerter, InStr(1, docStichwoerter, Tr) - 1)
docStichwoerter = Mid(docStichwoerter, InStr(1, docStichwoerter, Tr) + 1)
Me.txt_Kundenummer.Value = Left(docStichwoerter, InStr(1, docStichwoerter, Tr) - 1)
docStichwoerter = Mid(docStichwoerter, InStr(1, docStichwoerter, Tr) + 1)
'und so weiter.......
Else
MsgBox "Das ausgewählte Dokument kann nicht" & vbNewLine & "in das Linienformular zurü _
_
_
ckgeladen werden.", vbCritical + vbOKOnly, "Nicht unterstütztes Dokument"
End If
End Sub
Code zur PDF-Erstellung mit PDFCreator (Verweis PDFCreator muss vorhanden sein):
Sub pdfErstellung()
Dim pdfjob As PDFCreator.clsPDFCreator
Dim strVerzeichnis, strDateinamePDF As String
Dim xlOldPrinter As String
Dim pfad, fileName As String
Dim ws
Dim vorgabeTitel, vorgabeThema, vorgabeStichwortGesamt, vorgabeStichwort1, vorgabeStichwort2 _
_
_
As String
Dim vorgabeStichwort3, vorgabeStichwort4, vorgabeStichwort5, vorgabeStichwort6 As String
xlOldPrinter = Application.ActivePrinter
Set pdfjob = New PDFCreator.clsPDFCreator
pfad = "C:\temp\"
fileName = "test.pdf"
'je Stichwort 100 Zeichen:
vorgabeStichwort1 = " _
TestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTest" _
_
vorgabeStichwort2 = " _
TestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTest" _
_
vorgabeStichwort3 = " _
TestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTest" _
_
vorgabeStichwort4 = " _
TestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTest" _
_
vorgabeStichwort5 = " _
TestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTest" _
_
vorgabeStichwort6 = " _
TestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTestTest" _
_
'Stichwörter gesamt 600 Zeichen:
vorgabeStichwortGesamt = vorgabeStichwort1 & vorgabeStichwort2 & vorgabeStichwort3 & _
vorgabeStichwort4 & vorgabeStichwort5 & vorgabeStichwort6
Set ws = Application.ThisWorkbook.Sheets(1)
ws.Select
With pdfjob
.cStart "/NoProcessingAtStartup"
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = pfad
.cOption("AutosaveFilename") = fileName
.cOption("AutosaveFormat") = 0
.cOption("StandardTitle") = "Test PDF"
.cOption("StandardSubject") = "Version 1"
.cOption("StandardKeywords") = vorgabeStichwortGesamt
.cClearCache
End With
ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Sleep 1000
Loop
Sleep 1000
pdfjob.cPrinterStop = False
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
Sleep 1000
pdfjob.cPrinterStop = False
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
pdfjob.cClose
Set pdfjob = Nothing
Application.ActivePrinter = xlOldPrinter
End Sub
Anzeige