Feststellen, ob Excel-Sheet gedruckt wird/wurde

[Jumpy]

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