Druckerstatus auslesen Unter Zuhilfenahme des "Active Directory Service" lässt sich der Druckerstatus bequem auslesen.
Autor:   Dietmar G. Bayer	Bewertung:     [ Jetzt bewerten ]	Views:  31.820
ohne Homepage	System:  WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 17 Bewertung insgesamt: gut Durchschnittliche Bewertung: 3.8 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Unter Zuhilfenahme des "Active Directory Service" lässt sich der Druckerstatus bequem und einfach auslesen (z.B. Pause, Löscht, Druckt, etc.).

Erstellen Sie ein neues Projekt und markieren zunächst den Eintrag Active DS Type Library im Dialog "Verweise". Platzieren Sie anschließend ein ListView-Control auf die Form und darunter einen CommandButton. Beim Klick auf den CommandButton soll der Druckerstatus aller installierten Drucker ermittelt und im ListView-Control angezeigt werden.

Option Explicit
 
' Benötigte API-Deklaratione
Private Declare Function GetComputerName Lib "kernel32" _
  Alias "GetComputerNameA" ( _
  ByVal lpBuffer As String, _
  nSize As Long) As Long
 
' Druckerstatus
Const ADS_JOB_PAUSED = &H1
Const ADS_JOB_ERROR = &H2
Const ADS_JOB_DELETING = &H4
Const ADS_JOB_PRINTING = &H10
Const ADS_JOB_OFFLINE = &H20
Const ADS_JOB_PAPEROUT = &H40
Const ADS_JOB_PRINTED = &H80
Const ADS_JOB_DELETED = &H100

Private Sub Form_Load()
  Dim i As Long
 
  ' ListView-Spalten erstellen
  With ListView1.ColumnHeaders
    .Add, , "Printer", 3600
    .Add , , "Status", 1800
  End With
 
  ' auf Detailansicht umschalten
  ListView1.View = lvwReport
 
  ' alle Drucker auflisten
  For i = 0 To Printers.Count - 1
    ListView1.ListItems.Add , , Printers(i).DeviceName
  Next i
End Sub

' Druckerstatus aller im ListView aufgeführten 
' Drucker ermitteln
Private Sub Command1_Click()
  Dim sPrinter As String
  Dim sComputer As String
  Dim sPrinterName As String
  Dim sSearch As String
  Dim pq As IADsPrintQueue
  Dim pqo As IADsPrintQueueOperations
  Dim i As Long
 
  On Error GoTo ErrHandler
  Screen.MousePointer = 11
  With ListView1
    For i = 1 To .ListItems.Count
      With .ListItems(i)
        sPrinter = .Text
        If InStr(sPrinter, "auf") > 0 Then
          sComputer = Trim$(Mid$(sPrinter, InStr(sPrinter, "auf") + 4))
          sPrinterName = Trim$(Left$(sPrinterName, InStr(sPrinterName, "auf") - 1))
          If InStr(sPrinterName, "/") Then
            sPrinterName = ""
           ' das ist wegen "Automatisch Generic / Text Only auf KUBUS"
           ' Am besten umbenennen
          End If
        Else
          sPrinterName = sPrinter
          sComputer = GetComputerInfo
          ' hier was blödes
          If InStr(sPrinterName, "/") Then
            sPrinterName = ""
            ' das ist wegen "Automatisch Generic / Text Only auf KUBUS"
            ' Am besten umbenennen
          End If
        End If
 
        If Len(sPrinterName) > 0 Then
          sSearch = "WinNT://" + sComputer + "/" + sPrinterName
          Set pq = GetObject(sSearch)
          Set pqo = pq
          Select Case pqo.Status
            Case ADS_JOB_PAUSED
              .SubItems(1) = "Pause"
            Case ADS_JOB_ERROR
              .SubItems(1) = "Error"
            Case ADS_JOB_DELETING
              .SubItems(1) = "Löscht"
            Case ADS_JOB_PRINTING
              .SubItems(1) = "Druckt"
            Case ADS_JOB_OFFLINE
              .SubItems(1) = "ist Offline"
            Case ADS_JOB_PAPEROUT
              .SubItems(1) = "Papier fehlt"
            Case ADS_JOB_PRINTED
              .SubItems(1) = "Drucken fertig"
            Case ADS_JOB_DELETED
              .SubItems(1) = "Löschen fertig"
            Case Else
              .SubItems(1) = "wartet"
          End Select
        End If
      End With
    Next i
  End With
  Screen.MousePointer = 0
  Exit Sub
 
ErrHandler:
  ListView1.ListItems(i).SubItems(1) = "Fehler"
  Set pq = Nothing
  Set pqo = Nothing
  Resume Next
End Sub

' Die Funktion ermittelt den Computer-Namen
Public Function GetComputerInfo() As String
  Dim nResult As Long
  Dim sBuffer As String
 
  sBuffer = Space$(256)
  nResult = GetComputerName(sBuffer, Len(sBuffer))
  If InStr(sBuffer, Chr$(0)) > 0 Then _
    sBuffer = Left$(sBuffer, InStr(sBuffer, Chr$(0)) - 1)
 
  GetComputerInfo = sBuffer
End Function