Delphi-PRAXiS - Feststellen, ob Excel-Sheet gedruckt wird/wurde

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