AW: Drucken - Rückmeldung ob Dokument in Warteschlange
30.01.2004 20:14:29
Nepumuk
Hallo Klaus,
Beispielcode:
Option Explicit
Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, pDefault As Any) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) 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 cbBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
Private Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" (ByVal flags As Long, ByVal name As String, ByVal Level As Long, pPrinterEnum As Long, ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Type JOB_INFO
pDocument As String
End Type
Private Function Dokument_in_Spool(Dokument_name As String) As Boolean
Dim Retval As Long, hPrinter As Long, intIndex As Integer
Dim Data() As Long, DataLength As Long, JobCount As Long
Dim Jobs() As JOB_INFO
Retval = OpenPrinter(Printer(ActivePrinter), hPrinter, ByVal 0&)
Retval = EnumJobs(hPrinter, 0&, 256&, 2&, ByVal 0&, 0&, DataLength, JobCount)
If DataLength = 0 And Retval <> 0 Then
Call ClosePrinter(hPrinter)
Exit Function
End If
ReDim Data(DataLength - 1)
Retval = EnumJobs(hPrinter, 0&, 256&, 2&, Data(0), DataLength, DataLength, JobCount)
ReDim Jobs(JobCount - 1)
For intIndex = 0 To JobCount - 1
With Jobs(intIndex)
CopyStrVar .pDocument, Data(intIndex * 26 + 4)
If Dokument_name = Jobs(intIndex).pDocument Then Dokument_in_Spool = True: Exit For
End With
Next
Call ClosePrinter(hPrinter)
End Function
Private Function CopyStrVar(ByRef StrDest As String, ByRef VarSrc As Long)
StrDest = Space(lstrlen(VarSrc))
MoveMemory ByVal StrDest, ByVal VarSrc, Len(StrDest)
End Function
Private Function Printer(Printername As String) As String
Dim longbuffer() As Long, numbytes As Long, lngCnt As Integer
Dim numneeded As Long, numprinters As Long, Retval As Long
numbytes = 3076
ReDim longbuffer(0 To numbytes / 4) As Long
Retval = EnumPrinters(&H2, "", 1, longbuffer(0), numbytes, numneeded, numprinters)
If Retval = 0 Then
numbytes = numneeded
ReDim longbuffer(0 To numbytes / 4) As Long
Retval = EnumPrinters(&H2, "", 1, longbuffer(0), numbytes, numneeded, numprinters)
If Retval = 0 Then
MsgBox "Fehler bei der Druckersuche. Programmabbruch.", 16, "Warnung"
End
End If
End If
For lngCnt = 0 To numprinters - 1
Printer = Space(lstrlen(longbuffer(4 * lngCnt + 2)))
lstrcpy Printer, longbuffer(4 * lngCnt + 2)
If InStr(1, Printername, Printer) <> 0 Then Exit Function
Next
End Function
'***************************** Anwendungsbeispiel *****************************
Public Sub Beispiel()
Dim Timercount As Integer
Do
If Dokument_in_Spool("Testmappe.xls") Then
MsgBox "Druckauftrag von Testmappe.xls ist im Spool.", 64, "Information"
Exit Do
End If
Timercount = Timercount + 1
If Timercount = 10 Then
MsgBox "Druckauftrag von Testmappe.xls nach " & CStr(Timercount) & " Sekunden noch nicht im Spool." & vbCrLf & "Warten wird abgebrochen.", 48, "Hinweis"
Exit Do
End If
Sleep 1000
Loop
End Sub
Code eingefügt mit: Excel Code Jeanie
Gruß
Nepumuk