Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

AXP: PDF reihenweise, sortiert drucken

34 views
Skip to first unread message

Matthias Fitzner

unread,
Dec 15, 2010, 2:33:47 PM12/15/10
to
Hallo,

ich mï¿œchte eine ganze Reihe von PDF's ausdrucken, die auch sortiert aus
dem Drucker kommen sollen.

Der reine Aufruf mit ShellExecute fï¿œhrt dazu, dass einige Dateien
verschluckt werden.

CreateProcess mit WaitForSingleObject fï¿œhrt dazu, das alle PDF
ausgedruckt werden, aber die Druckreihenfolge hat nichts mit der
Reihenfolge der Druckerwarteschlange zu tun.

Zuerst wird der kpl. Code abgearbeitet, dann druckt Windows die PDF's in
einer Reihenfolge, die ich nicht nachvollziehen kann.

Die u.g. Funktion rufe ich in einer Schleife durch des Recordset auf.

Eigentlich hatte ich erwartet, daᅵ der Code die nᅵchste Datei erst dann
aufruft, wenn das Acrobat-Fenster geschlossen ist.

Dem ist aber nicht so.

Function fktWaitForPDF(Aktion As String, stDatei) As Boolean
Dim ProcInfo As PROCESS_INFORMATION, StartInfo As STARTUPINFO
'Aktion = "C:\Program Files\Adobe\Acrobat 8.0\Acrobat\Acrobat.exe /P "

With StartInfo
.cb = Len(StartInfo) ' Grᅵᅵe der Struktur ᅵbergeben
.dwFlags = STARTF_USESHOWWINDOW ' Angeben, dass .wShowWindow benutzt wird
.wShowWindow = 1 ' Fensterstil setzen
End With
If CreateProcess(0&, Aktion & stDatei, 0&, 0&, 1&,
NORMAL_PRIORITY_CLASS, 0&, 0&, StartInfo, ProcInfo) = 0 Then
MsgBox "CreateProcess konnte Acrobat.exe nicht ausfï¿œhren."
End If
While WaitForSingleObject(ProcInfo.hProcess, 0) = WAIT_TIMEOUT
DoEvents ' Zeitscheibe fortfï¿œhren, danach Kontrolle an Windows
Wend
End Function

Hier lï¿œufts genauso ab. Code lï¿œuft durch, dann werden die Fenster
geï¿œffnet und gedruckt, schï¿œn eines nach dem anderen nur die Reihenfolge
stimmt nicht mit der des Funktionsaufrufes.

Function fktWaitForPDF(Aktion As String, stDatei) As Boolean
' Startoptionen festlegen
With ShExInfo
.cbSize = Len(ShExInfo)
'.fMask = SEE_MASK_FLAG_NO_UI Or SEE_MASK_CLASSNAME Or
SEE_MASK_NOCLOSEPROCESS
.hwnd = Me.hwnd
.lpVerb = Aktion
.lpFile = stDatei
.lpParameters = ""
.lpDirectory = DirName
.nShow = SW_SHOWMAXIMIZED
End With
' Programm ausfï¿œhren
Retval = ShellExecuteEx(ShExInfo)
If Retval = 0 Then
' bei Fehler Text ausgeben
Select Case ShExInfo.hInstApp
Case SE_ERR_ACCESSDENIED
Err.Raise 5, "ShellExecuteEx", "Zugriff verweigert"
Case SE_ERR_FNF
Err.Raise 5, "ShellExecuteEx", "Datei nicht gefunden"
Case SE_ERR_NOASSOC
Err.Raise 5, "ShellExecuteEx", "Datei ist mit keinem Programm verknï¿œpft"
End Select
fktWaitForPDF = False
Else
'erfolgreich gedruckte Datei lï¿œschen
fktWaitForPDF = True
End If
' warten bis die Anwendung beendet wird
test = WaitForSingleObject(ShExInfo.hProcess, INFINITE)
Do While test = 1
test = WaitForSingleObject(ShExInfo.hProcess, INFINITE)
Loop
End Function

Ich hoffe es gibt eine Mï¿œglichkeit ohne dass der Benutzer jede Datei
einzeln bestᅵtigen muᅵ.

Gruᅵ Matthias Fitzner

Josef Poetzl

unread,
Dec 15, 2010, 2:39:15 PM12/15/10
to
Hallo!

Matthias Fitzner schrieb:
> ich möchte eine ganze Reihe von PDF's ausdrucken, die auch sortiert aus
> dem Drucker kommen sollen.

Ich benötigte so etwas auch einmal und führte dafür zuerst alle
PDF-Dateien zu einer einzigen PDF-Datei zusammen, die ich dann an den
Drucker schickte.
Zum verbindend er PDF-Dateien nutzte ich MergePDFDocuments aus
"StrStorage.dll" von Stephen Lebans.

> Der reine Aufruf mit ShellExecute führt dazu, dass einige Dateien
> verschluckt werden.

Hast du auch DDE (DDEExecute & Co.) probiert?


mfg
Josef

Matthias Fitzner

unread,
Dec 15, 2010, 2:46:57 PM12/15/10
to
Am 15.12.2010 20:39, schrieb Josef Poetzl:
> Hallo!
>
> Matthias Fitzner schrieb:
>> ich möchte eine ganze Reihe von PDF's ausdrucken, die auch sortiert aus
>> dem Drucker kommen sollen.
>
> Ich benötigte so etwas auch einmal und führte dafür zuerst alle
> PDF-Dateien zu einer einzigen PDF-Datei zusammen, die ich dann an den
> Drucker schickte.
> Zum verbindend er PDF-Dateien nutzte ich MergePDFDocuments aus
> "StrStorage.dll" von Stephen Lebans.
Das scheint mir ein ziemlicher Aufwand und ergibt bestimmt auch eine
mächtige PDF-Datei.

>
>> Der reine Aufruf mit ShellExecute führt dazu, dass einige Dateien
>> verschluckt werden.
>
> Hast du auch DDE (DDEExecute& Co.) probiert?
Habe ich noch nicht versucht!
>
>
> mfg
> Josef

Mach ich aber heute nicht mehr!
Vielen Dank!

Mafi

Thomas Möller

unread,
Dec 15, 2010, 3:03:33 PM12/15/10
to
Hallo Matthias,

Am 15.12.2010 20:33, schrieb Matthias Fitzner:
> ich möchte eine ganze Reihe von PDF's ausdrucken, die auch sortiert aus
> dem Drucker kommen sollen.
> Der reine Aufruf mit ShellExecute führt dazu, dass einige Dateien
> verschluckt werden.
>
> CreateProcess mit WaitForSingleObject führt dazu, das alle PDF


> ausgedruckt werden, aber die Druckreihenfolge hat nichts mit der
> Reihenfolge der Druckerwarteschlange zu tun.

ich kann mich erinnern, dass ich ein solches Thema mal mit Hilfe dieser
Beispieldatenbank zum Laufen gebracht habe:
http://www.alessandrobaraldi.it/UpdateDWN.asp?IdFAQ=236

Ob dabei die Reihenfolge der Dokumente erhalten geblieben ist, kann ich
allerdings nicht mehr sagen.

CU
--
Thomas

Homepage: www.Team-Moeller.de

Matthias Fitzner

unread,
Dec 16, 2010, 5:27:58 AM12/16/10
to
Am 15.12.10 21:03, schrieb Thomas Möller:

Hallo Thomas!

Ich hab es mit 6 PDF's versucht.
nach dem Aufruf der Funktion fktWaitForPDF bei rs.Delete habe ich einen
Haltepunkt gesetzt und den Code mit F5 erst weiter laufen lassen, wenn
das Adobefenster von der Taskleiste verschwunden ist. Die Zeichnungen
kamen in der richtigen Reihenfolge.

Ohne den Haltepunkt werden die Einträge im Ufo im Sekundentakt gelöscht,
erst dann erfolgt das Drucken (sieht man in der Taskleiste).
Reihenfolge der Zeichnungen im Drucker:
1. 4. Zeichnung
2. 1. Zeichnung
3. 6. Zeichnung
4. 5. Zeichnung
5. 2. Zeichnung
6. 3. Zeichnung

Function fktWaitForPDF(Aktion As String, stDatei) As Boolean

Dim sei As SHELLEXECUTEINFO
Dim RetVal As Long

With sei
.cbSize = Len(sei)
.fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_FLAG_DDEWAIT Or
SEE_MASK_NO_CONSOLE
.hwnd = GetDesktopWindow()


.lpVerb = Aktion
.lpFile = stDatei
.lpParameters = ""
.lpDirectory = ""

.nShow = 0 '0=unsichtbar,2-SHOWMINIMIZED, 3-SHOWMAXIMIZED, 5-show
6-minimiert, 9-RESTORE, 10-showdefault,
End With
' Open the file using its associated program.
RetVal = ShellExecuteEx(sei)
fktWaitForPDF = (RetVal <> 0)

If RetVal = 0 Then
' The function failed, so report the error. Err.LastDllError
' could also be used instead, if you wish.
Dim msg As String
Select Case sei.hInstApp
Case SE_ERR_FNF: msg = "File not found"
Case SE_ERR_PNF: msg = "Path not found"
Case SE_ERR_ACCESSDENIED: msg = "Access denied"
Case SE_ERR_OOM: msg = "Out of memory"
Case SE_ERR_DLLNOTFOUND: msg = "DLL not found"
Case SE_ERR_SHARE: msg = "A sharing violation occurred"
Case SE_ERR_ASSOCINCOMPLETE: msg = "Incomplete or invalid file
association "
Case SE_ERR_DDETIMEOUT: msg = "DDE Time out"
Case SE_ERR_DDEFAIL: msg = "DDE transaction failed"
Case SE_ERR_DDEBUSY: msg = "DDE busy"
Case SE_ERR_NOASSOC: msg = "No association for file extension"
Case ERROR_BAD_FORMAT: msg = "Invalid EXE file or error in EXE
image"
Case Else: msg = "Unknown error"
End Select
MsgBox "Error " & sei.hInstApp & ": " & msg, vbOKOnly + vbExclamation
fktWaitForPDF = False
Else
'--- warten ---
' Wait for the opened process to close before continuing. Instead
' of waiting once for a time of INFINITE, this example repeatedly
checks to see if the
' is still open. This allows the DoEvents VB function to be
called, preventing
' our program from appearing to lock up while it waits.
Do
DoEvents
RetVal = WaitForSingleObject(sei.hProcess, 0)
Loop While RetVal = WAIT_TIMEOUT
Call CloseHandle(sei.hProcess)
End If
End Function

Hier der Aufrufende Sub

Das Warten auf die Beendigung des Task scheint mit WaitForSingleObject
nicht zu klappen.


Private Sub cmd2A3_Click()
rs.MoveNext
Do While Not rs.EOF
If fktVollenDateinamen(rs!IdNummer) = False Then
Beep
Else
'Format prüfen
If IsNull(rs!Format) Then
Format = fktPDFFormat(Fullfilename)
Else
Format = rs!Format
End If

If Format >= 3 Then
If fktWaitForPDF("Print", Fullfilename) = True Then
'erfolgreich gedruckt
rs.Delete 'Hier solange warten bis der Task
verschwunden ist
Me.UFO_PDFListe.Requery
End If
Else
FMsgbox "Die Datei ist größer als A3 und wird
übersprungen.@Es wird mit der nächsten Datei fortgefahren!@Das
ermittelte Format wird in die Liste eingetragen.", vbInformation + vbOKOnly
rs.Edit
rs!Format = Format
rs.Update
End If
End If
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
Me.cmd1A0.SetFocus
End Sub

Matthias Fitzner

unread,
Dec 16, 2010, 9:37:40 AM12/16/10
to
Am 15.12.10 20:39, schrieb Josef Poetzl:

Damit habe ich es hin bekommen:

Hier für alle der neue Code.

Option Compare Database
Option Explicit
Private Declare Function FindExecutable Lib "shell32.dll" Alias
"FindExecutableA" _
(ByVal lpFile As String, ByVal lpDirectory As String, ByVal
lpResult As String) As Long

Function fktWaitForPDF(Aktion As String, stDatei) As Boolean

Dim sPDF As String
Dim sExe As String
Dim iChan As Long
Dim hwnd As Long
Dim inti As Long
On Error GoTo Fehler
sPDF = Chr(34) & stDatei & Chr(34)
sExe = String(255, 0)
FindExecutable sPDF, vbNullString, sExe
sExe = Left(sExe, InStr(1, sExe, vbNullChar) - 1)
If InStr(1, sExe, "acrobat") = 0 And InStr(1, sExe, "acrord32") = 0
Then
MsgBox "Kein Acrobat oder -Reader gefunden", vbCritical
Exit Function
End If
sExe = Chr(34) & sExe & Chr(34)
If Aktion = "print" Then
Shell sExe, vbHide
Else
Shell sExe, vbMaximizedFocus
End If
DoEvents
iChan = DDEInitiate("acroview", "control") 'DDE initialisieren
DDEExecute iChan, "[DocOpen(" & sPDF & ")]" 'PDF öffnen
DoEvents
If Aktion = "print" Then DDEExecute iChan, "[FilePrintSilent(" &
sPDF & ")]" 'PDF drucken
DoEvents
fktWaitForPDF = True
Ende:
On Error Resume Next
DDEExecute iChan, "[AppExit]" 'Dieser Befehl würde Acrobat wieder
schließen
'DDETerminateAll
Exit Function
Fehler:
fktWaitForPDF = False
MsgBox Err.Description
GoTo Ende
End Function


unter http://acrobat-dde.nnn2.com/ kann die anderen Messages von Acrobat
nachlesen.


Gruß Mafi

>
>
> mfg
> Josef

0 new messages