Hi Detlev,
erneut besten Dank für Deine Hilfe. Der Code sieht sehr gut und viel versprechend aus.
Leider besteht noch ein merkwürdiges Problem, aber vielleicht sehe ich auch den Baum vor lauter Wald nicht mehr :-P
- Bei Deinem Registry-Lesealgorhythmus kommt bei mir der Fehler "Ungültige Wurzel im Reg.-Schlüssel. Das habe ich umgangen, indem ich den Pfad einfach direkt übergebe.
- Beim Shell-Befehl kommt bei mir der Fehler "Datei nicht gefunden" ... Das ist völlig verwirrend, weil ich bereits 10x geprüft habe, dass der Pfad richtig ist ...
Kann es dafür einen anderen Grund geben, oder sollte ich lieber mal ne Nacht drüber schlafen.
Hier mal der gesamte Code:
Public Sub ppddff()
'BASIS
Dim gApp As Acrobat.CAcroApp
Dim AvDoc As Acrobat.CAcroAVDoc
Dim gPDDoc As Acrobat.CAcroPDDoc
'FÜR ADOBE FORMULAR
Dim FormApp As AFORMAUTLib.AFormApp
Dim AcroForm As AFORMAUTLib.Fields
Dim Field As AFORMAUTLib.Field
'FÜR PRINT TO FILE
'Dim pdfDIST As PdfDistiller
Dim ORD As String
Dim PRG As String
Dim OPT As String
Dim DAT As String
'Sonstiges
Dim x As Boolean
Const DOC_FOLDER As String = "K:\01 Portfoliomanagement\PM\03 Projekte\Fondstauschprogramm"
'OBJEKTE
Set gApp = CreateObject("AcroExch.App")
Set gPDDoc = CreateObject("AcroExch.PDDoc")
Set AvDoc = CreateObject("AcroExch.AVDoc")
'Set pdfDIST = New Distiller
Set FormApp = CreateObject("AFormAut.App")
x = AvDoc.Open(DOC_FOLDER & "\TEST.pdf", "TEST")
AvDoc.Maximize (1) 'Damit ich zuschauen kann
'Do Until Sheets("XY").cells(y,x) = "" - für alle Einträge in Excel-Liste XY
For Each Field In FormApp.Fields
If Field.Name = "Name" Then
Field.Value = "XXXXX" 'Sheets("XY").Cells(y, 1)
End If
' If Field.Name = "Vorname" Then
' Field.Value = Sheets("XY").Cells(y, 2)
' End If
' und so weiter
' If Field.Name = "Straße Hausnummer" Then
' Field.Value = "XXXXX"
' End If
' If Field.Name = "PLZ Wohnort" Then
' Field.Value = "XXXXX"
' End If
' If Field.Name = "Vorwahl Telefon" Then
' Field.Value = "XXXXX"
' End If
' If Field.Name = "Geburtsdatum" Then
' Field.Value = "XXXXX"
' End If
' If Field.Name = "Geburtsort" Then
' Field.Value = "XXXXX"
' End If
' If Field.Name = "Staatsangehörigkeit" Then
' Field.Value = "XXXXX"
' End If
' If Field.Name = "Finanzamt PLZ Ort" Then
' Field.Value = "XXXXX"
' End If
' If Field.Name = "Steuernummer" Then
' Field.Value = "XXXXX"
' End If
' If Field.Name = "Beruf" Then
' Field.Value = "XXXXX"
' End If
' If Field.Name = "Bankverbindung für Auszahlungen" Then
' Field.Value = "XXXXX"
' End If
' If Field.Name = "Kontonummer" Then
' Field.Value = "XXXXX"
' End If
' If Field.Name = "Bankleitzahl" Then
' Field.Value = "XXXXX"
' End If
Next
'###### PDF-Formular als .pdf in einem Ordner ablegen und danach weiter mit dem nächsten Excel-Eintrag
'VERSUCH 1
' x = AvDoc.Save(PDSaveFull, DOC_FOLDER & "\TEST2.pdf")
'VERSUCH 2
' pdfDIST.FileToPDF AvDoc, DOC_FOLDER & "\TEST2.pdf", ""
'VERSUCH 3
'
ORD = "HKCR\Software\Adobe\Acrobat\Exe\"
If ORD <> "" Then
Set oWSHShell = CreateObject("Wscript.Shell")
Set oFs = CreateObject("Scripting.FileSystemObject")
'Msgbox oWSHShell.RegRead(ORD)
' PRG = Replace(oWSHShell.RegRead(Ordner), "", "")
PRG = "C:\Program Files (x86)\Adobe\Acrobat 9.0\Acrobat\Acrobat.exe"
Set oWSHShell = Nothing
Set oFs = Nothing
Else
PRG = ""
''' Und hier Programm verlassen weil kein Reader installiert'''
'exit Sub
End If
OPT = "/P /H /N"
'/N Launches a separate instance of Acrobat or Adobe Reader, even if one is currently open.
'/S Opens Acrobat or Adobe Reader, suppressing the splash screen.
'/O Opens Acrobat or Adobe Reader, suppressing the open file dialog.
'/H Opens Acrobat or Adobe Reader in a minimized window.
'/P Print File
'/T Print File
DAT = DOC_FOLDER & "\TEST.pdf"
If Dir(DAT) <> "" Then
'msgbox Datei
If Dir(PRG) <> "" Then
'msgbox Program & Option
Shell PRG & OPT & DAT, vbaMinimizedNoFocus
End If
End If
'VERSUCH ENDE
'LOOP ENDE
AcroApp.Exit
Set gApp = Nothing
Set gPDDoc = Nothing
Set AvDoc = Nothing
End Sub
|