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):

markieren

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

Definiere "gedruckt"!

Seit mein Drucker "im Netz" ist, weiß ich, daß es viele Möglichkeiten gibt einen Ausdruck verschwinden zu lassen. das gilt wahrscheinlich auch für lokale Drucker aber ist dort seltener.

Wenn du den Ausdruck protokollieren willst, würde ich Dir raten den Ausdruck über OLE zu initiieren und dann gleich das Protokoll zu schreiben.

Gruß
K-H

Zitat von p80286:

Definiere "gedruckt"!

Das ist die Königsfrage.

Da alles automatisiert abläuft könnt ich natürlich sagen, sobald ich

markieren

Code:

Worksheet("MySheet").PrintOut

abgesetzt habe gilt das für mich als gedruckt, meine Arbeit ist getan, nach mir die Sinnflut.

Ich bild mir aber ein, dass wenn ich den Spoolserver überwache, kann ich nicht nur sagen, ich habs gedruckt, sondern auch, dass es beim Drucker angekommen ist. Der kann das natürlich immer noch gefressen haben, oder so, sprich das ist noch immer keine Garantie, dass das Blatt auch wirklich erzeugt wurde, aber ich habe schonmal die falsch-positiven Ereignisse ausgeschlossen, bei denen ich bei Möglichkeit eins (oben) gesagt hätte ist gedruckt, dabei ist es noch nichtmal beim Drucker angekommen.

Ich würde mal bei WinApi.WinSpool.Enumjobs schauen und die JOB_INFO Strukturen. Da kannst Du den Jobstatus sehen. Setzt aber voraus, dass Du den Dokumentnamen im Spooler "wiedererkennst". Wir haben das dadurch gelöst, dass wir an unsere Jobnamen eine ID ranhängen: "EPos Lieferschein 123456789 ID:0000001982989819". Damit können wir dann auf Die Datenbank gehen und den zugehörigen Eintrag identifizieren.

Ein zusätzlicher Ansatz wäre das System-Ereignisprotokoll, dort stehen ja die abgeschlossenen Printjobs drin.

Zitat von spoolsvc on cluster02:

Datum: 29.09.2011 Source: Print
Uhrzeit: 18:03:33
Event ID: 10
Dokument 182, VBS-Labelheader LID:38720690 im Besitz von xxxx wurde über Anschluss Z_10.39.30.19 auf xxxxxxx19 gedruckt. Größe in Bytes: 8096; Seiten gedruckt: 1