Registriert seit: 9. Dez 2010
Ort: Mönchengladbach
1.737 Beiträge
Delphi 6 Enterprise
|
Feststellen, ob Excel-Sheet gedruckt wird/wurde
29. Sep 2011, 14:39
Hallo,
bei einer automatisch ablaufenden Excel-Verarbeitung wird in einer DB-Tabelle (als Log) festgehalten, welche Ergebnissheets gedruckt werden sollen und sobald ein Sheet tatsächlich gedruckt wurde, soll das im der Log-Tabelle entsprechend kenntlich gemacht werden.
Ich habe dazu überlegt den Spoolserver zu überwachen und mir dazu diverse APIs aus einem Tipp, den ich in einem Forum gefunden habe zusammenkopiert und in eine Funktion InSpooler zusammengepakt (s.u.).
Dann hab ich mal eine Testprozedur gebaut, die innerhalb einer Endlosschleife den Druck anstößt und immer wieder diese Überwachungsfunktion InSpooler aufruft.
Die Endlosschleife ist dabei natürlich nicht wirklich endlos, wenn ein counter eine maximale Größe erreicht hat, bricht sie ab (das könnte man nat. statt mit counter auch anders lösen, indem man eine Zeit vorgibt, die die Schleife laufen darf und zischendurch immer die Systemzeit checkt).
Das Ganze funktioniert bisher wie es soll, doch kommt mir das so unelegant vor und ich frage mich, ob es da nix besseres gibt, bzw. ob man die Routine generell verbessern kann.
Mir spukt auch das Folgende im Kopf rum. Wenn ich was drucke kommt ja auch immer diese "Tooltip"-Meldung: Dokument wurde an drucker gesendet. Kann man die nicht irgendwie abfangen/auswerten?
Hier auf jeden Fall, was ich schonmal habe (VBA):
Code:
Option Explicit
Private Declare Function ClosePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As Long
Private Declare Function OpenPrinter Lib "winspool.drv" Alias _
"OpenPrinterA" (ByVal pPrinterName As String, phPrinter _
As Long, pDefault As PRINTER_DEFAULTS) As Long
Private Declare Function EnumJobs Lib "winspool.drv" Alias _
"EnumJobsA" (ByVal hPrinter As Long, ByVal FirstJob _
As Long, ByVal NoJobs As Long, ByVal Level As Long, _
pJob As Long, ByVal cdBuf As Long, pcbNeeded As _
Long, pcReturned As Long) As Long
Private Declare Function PtrToStr Lib "kernel32" Alias _
"lstrcpyA" (ByVal RetVal As String, ByVal Ptr As _
Long) As Long
Private Declare Function StrLen Lib "kernel32" Alias _
"lstrlenA" (ByVal Ptr As Long) As Long
Private Type PRINTER_DEFAULTS
pDatatype As Long
pDevMode As Long
DesiredAccess As Long
End Type
Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000
Const PRINTER_ACCESS_ADMINISTER As Long = &H4&
Const PRINTER_ACCESS_USE As Long = &H8&
Const PRINTER_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED Or _
PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)
Private Const INFINITE As Long = &HFFFFFFFF
Private Function InSpooler() As Integer
Dim Result As Long, Required As Long, BufLen As Long
Dim Buffer() As Long, Entries As Long
Dim hPrinter As Long, l As Long, x As Long
Dim LiMem As Integer
Dim PName As String, aa As String
Dim pd As PRINTER_DEFAULTS
Dim str_machine As String, str_user As String, str_doc As String
Const c& = 16
' Damit das ganze auch auf NT-basierenden Systemen funktioniert
pd.DesiredAccess = PRINTER_ALL_ACCESS
BufLen = 4
ReDim Buffer(0)
'Standarddruckername erfahren
PName = Application.ActivePrinter
PName = Trim(Left(PName, InStr(PName, " auf")))
'Drucker öffnen
Result = OpenPrinter(PName, hPrinter, pd)
If Result <> 0 Then
'Alles bisher gut gelaufen, jetzt mal abklopfen wieviel
'Platz wir brauchen
Result = EnumJobs(hPrinter, 0, INFINITE, 1, Buffer(0), _
BufLen, Required, Entries)
If Result <> 0 And Required = 0 Then
'Keine Jobs in der Warteschlange
'Printerhandle wieder schließen
Call ClosePrinter(hPrinter)
InSpooler = 0
Exit Function
ElseIf Result = 0 And Required > 0 Then
'Ist der Puffer groß genug?
BufLen = Required
ReDim Buffer((BufLen / 4) - 1)
Result = EnumJobs(hPrinter, 0, INFINITE, 1, Buffer(0), _
BufLen, Required, Entries)
If Result = 0 Then
'Fehler
'Call MsgBox("Beim Ermitteln der Jobs ist ein Fehler aufgetreten.", vbExclamation + vbOKOnly)
'Printerhandle wieder schließen
Call ClosePrinter(hPrinter)
InSpooler = -1
Exit Function
End If
Else
'Fehler
'Call MsgBox("Beim Ermitteln der Jobs ist ein Fehler aufgetreten.", vbExclamation + vbOKOnly)
'Printerhandle wieder schließen
Call ClosePrinter(hPrinter)
InSpooler = -1
Exit Function
End If
'Printerhandle wieder schließen
Call ClosePrinter(hPrinter)
For x = 0 To Entries - 1
'Rechnername: Buffer(2), gleiches Spiel wie oben
aa = Space$(StrLen(Buffer(c * x + 2)) + 1)
Call PtrToStr(aa, Buffer(c * x + 2))
aa = Trim$(Left$(aa, InStr(aa, Chr$(0)) - 1))
str_machine = aa
'Username: Buffer(3), gleiches Spiel wie oben
aa = Space$(StrLen(Buffer(c * x + 3)) + 1)
Call PtrToStr(aa, Buffer(c * x + 3))
aa = Left$(aa, InStr(aa, Chr$(0)) - 1)
str_user = aa
'Dokumentenname
aa = Space$(StrLen(Buffer(c * x + 4)) + 1)
Call PtrToStr(aa, Buffer(c * x + 4))
aa = Left$(aa, InStr(aa, Chr$(0)) - 1)
str_doc = aa
'Check
If str_user = Projekt.UserName And str_doc = ThisWorkbook.Name Then
InSpooler = 1
Exit Function
End If
Next x
InSpooler = 0
End If
End Function
Sub test()
Dim Detected As Boolean, i As Integer, j As Integer
Detected = False
i = 0
Do While True
If InSpooler = 1 Then
Detected = True
j = j + 1
Else
If Not Detected Then
If i = 2 Then
Worksheets("Daten").PrintOut
End If
Else
MsgBox "Druck fertig " & i & "/" & j
Exit Sub
End If
End If
i = i + 1
If i = 5000 And Not Detected Then
MsgBox "Not detected"
Exit Sub
End If
If j = 5000 And Detected Then
MsgBox "Detected but no end"
Exit Sub
End If
Loop
End Sub
Ralph
|