Halli hallo,
ich habe schon ewig gegoogled aber noch nix gefunden, deshalb hoffe ich auf eure Hilfe:
Wie kann ich alle Druckaufträge im Spooler vom Windows-Standartdrucker löschen?
Ich bräuchte einen Button-->klick-->Druckaufträge weg...
Kann mir da jemand helfen?
hi,
hilft dir das vielleicht weiter?
http://www.vbarchiv.net/tipps/details.php?id=136 (http://www.vbarchiv.net/tipps/details.php?id=136)
p.s. unter dem Code im Beispiel bitte auch den Hinweis beachten!
Hallo,
ja das hatte ich gefunden, aber mir schmiert der Rechner ab bzw. Access bleibt hängen...
Ich hab es wie folgt eingebaut:
Formular mit 1 Button.
Im Vba-Kopfbereich dieses:
Private Declare Function SetPrinter Lib "winspool.drv" _
Alias "SetPrinterA" ( _
ByVal hPrinter As Long, _
ByVal Level As Long, _
pPrinter As Any, _
ByVal Command As Long) As Long
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 Const PRINTER_CONTROL_PURGE = 3
Private Type PRINTER_DEFAULTS
pDatatype As String
pDevMode As Long
DesiredAccess As Long
End Type
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const PRINTER_ATTRIBUTE_DEFAULT = &H4
Private Const PRINTER_ACCESS_ADMINISTER = &H4
Private Const PRINTER_ACCESS_USE = &H8
Private Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)
Über den Button dann eine Schleife für 25 Sekunden laufen lassen (i ist ein Wert aus einem anderen System, funzt aber-hier nur i=1 zum Test damit die i-Schleife immer weiter läuft)
Private Sub Befehl1_Click()
Do While i > 0
i = 1
For x = 1 To 25
DoEvents
sleep 1000
Next x
If x > 29 Then GoTo Codestop Else GoTo loopnext
loopnext:
Loop
Codestop:
Call DeleteDocsFromPrinterQueue
MsgBox "stop"
End Sub
Und dann noch das Modul mit dem Inhalt
Public Sub DeleteDocsFromPrinterQueue(Optional _
ByVal prnName As String)
Dim Result As Long
Dim hPrinter As Variant
Dim udtPrinter As PRINTER_DEFAULTS
If IsMissing(prnName) Or prnName = "" Then _
prnName = Printer.DeviceName
udtPrinter.DesiredAccess = PRINTER_ALL_ACCESS
Result = OpenPrinter(prnName, hPrinter, udtPrinter)
If hPrinter <> 0 Then
Result = SetPrinter(hPrinter, 0, vbNull, _
PRINTER_CONTROL_PURGE)
If Result = 0 Then RaiseLastWin32Error
End If
Result = ClosePrinter(hPrinter)
Wenn ich das ausführe bleibt das System hängen... Aber warum????
Private Sub Befehl1_Click()
Do While i > 0
i = 1
For x = 1 To 25
DoEvents
sleep 1000
Next x
If x > 29 Then GoTo Codestop Else GoTo loopnext
loopnext:
Loop
Codestop:
Call DeleteDocsFromPrinterQueue
MsgBox "stop"
End Sub
Ich weis jetzt nicht was du mit dieser Funktion erreichen willst.
i ist 0, also wird die do/loop-schleife nicht gestartet (do while i>0), ausser i ist irgendwo global definert.
Zum anderen, wenn i >= 1 ist wird die Do/loop gestartet wird aber nie beendet weil For x = 1 To 25 den x-Wert immer zurücksetzt und der Wert 29 nie erreicht wird.
müsste also lauten: If x > 25 Then exit Do
Die Funktion DeleteDocsFromPrinterQueue selbst schein zu funktionieren. Was sich bei dir jetzt aufhängt kann ich nicht reproduziren.
Hallo,
bei der Schleife scheint mir ein Fehler beim kopieren unterlaufen zu sein. Da steht bei mir schon
>25 aber muss es mit exit do beendet werden oder geht auch mein goto?
Beim Spooler-löschen geht er ins debug und markiert mir mit Benutzerdefinierter Typ nicht definiert den Code
udtPrinter As PRINTER_DEFAULTS
Greift der Code denn automatisch auf den Windows Standartdrucker zu? Wenn nicht, wie bekomme ich das hin?
Bin hiermit leicht überfordert....
komischerweise markiert er manchmal auch dieses:
RaiseLastWin32Error
Es scheint fast abwechselnd zu sein... oder habe ich etwas vergessen?
AHHH ok,
hab das fehlende Modul ergänzt und Z A C K alles geht..
Für alle die diese Funktion nutzen möchten:
Einfach folgenden Code in ein Modul setzten und schon geht es:
Option Explicit
' Benötigte API-Deklarationen
Private Declare Function FormatMessage Lib "kernel32" _
Alias "FormatMessageA" ( _
ByVal dwFlags As Long, _
lpSource As Any, _
ByVal dwMessageId As Long, _
ByVal dwLanguageId As Long, _
lpBuffer As Long, _
ByVal nSize As Long, _
Arguments As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" ( _
Destination As Any, _
Source As Any, _
ByVal Length As Long)
Private Declare Function LocalFree Lib "kernel32" ( _
ByVal hMem As Long) As Long
' ----------------------------------------------------
' Letzten Fehler einer WinAPI Funktion im Klartext
' ermitteln
' ----------------------------------------------------
Public Sub RaiseLastWin32Error()
Const UNKNOW_WIN32API_ERROR = _
"Ein unbekannter Win32 API Fehler ist aufgetreten."
Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
Const LANG_NEUTRAL = &H0
Const ERROR_SUCCESS = 0&
Dim Buffer As Long
Dim Length As Long
Dim ErrorMsg As String
Dim LastError As Long
' Letzten Win32 API Fehler ermitteln
LastError = Err.LastDllError
' Win32 API Fehler von Windows in einen Text ausgeben
Length = FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER Or _
FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, _
0&, LastError, LANG_NEUTRAL, Buffer, 0, 0)
' Prüfen ob letzter Fehler wirklich ein Fehler war
' und prüfen ob FormatMessage einen Text bereit
' gestellt hat
If (LastError <> ERROR_SUCCESS) And (Length <> 0) Then
ErrorMsg = String$(Length, vbNullChar)
Call CopyMemory(ByVal ErrorMsg, ByVal Buffer, Length)
Call LocalFree(Buffer)
Else
ErrorMsg = UNKNOW_WIN32API_ERROR
End If
' Fehlermeldung ausgeben
Call Err.Raise(Number:=vbObjectError + LastError, _
Source:="RaiseLastWin32Error", Description:=ErrorMsg)
End Sub