Private Declare Function GetComputerName Lib "kernel32" _
  Alias "GetComputerNameA" (ByVal lpBuffer As String, _
  nSize As Long) As Long
 
Rem STATUS
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 Command2_Click()
  End
End Sub
'Die Funktion ermittelt den Computer-Namen
Public Function GetComputerInfo() As String
  Dim Result As Long
  Dim cInfo As String
 
  cInfo = Space$(256)
  Result = GetComputerName(cInfo, Len(cInfo))
  If InStr(cInfo, Chr$(0)) > 0 Then _
    cInfo = Left$(cInfo, InStr(cInfo, Chr$(0)) - 1)
 
  GetComputerInfo = cInfo
End Function
Private Sub Form_Load()
  Dim cl As ColumnHeader
  Dim it As ListItem
  Dim Sel_Printer As String
  Dim Sel_Comp As String
  Dim Sel_PrinterName As String
  Dim Such As String
  Dim pq As IADsPrintQueue
  Dim pqo As IADsPrintQueueOperations
 
 
  Set cl = LV.ColumnHeaders.Add(, , "Printer", 3600)
  Set cl = LV.ColumnHeaders.Add(, , "Status", 1800)
 
 
  For i = 0 To Printers.Count - 1
    Set it = LV.ListItems.Add()
    it.Text = Printers(i).DeviceName
 
  Next
 
 
  On Error GoTo Cleanup
  For i = 1 To LV.ListItems.Count
    Sel_Printer = LV.ListItems.Item(i).Text
    Sel_Comp = Trim(Mid(Sel_Printer, InStr(Sel_Printer, "auf") + 4))
    If InStr(Sel_Printer, "auf") > 0 Then
      Rem NETZ
      Sel_PrinterName = Trim(Mid(Sel_Printer, 12))
      Sel_PrinterName = Trim(Left(Sel_PrinterName, InStr(Sel_PrinterName, _
        "auf") - 1))
      If InStr(Sel_PrinterName, "/") Then
        Sel_PrinterName = ""
        'das ist wegen "Automatisch Generic / Text Only auf KUBUS"
        'Am besten umbenennen
      End If
    Else
 
      Sel_PrinterName = Sel_Printer
 
      Sel_Comp = GetComputerInfo
 
      'hier was blödes
      If InStr(Sel_PrinterName, "/") Then
        Sel_PrinterName = ""
        'das ist wegen "Automatisch Generic / Text Only auf KUBUS"
        'Am besten umbenennen
      End If
 
    End If
    If Sel_PrinterName > "" Then
      Such = "WinNT://" + Sel_Comp + "/" + Sel_PrinterName
      Set pq = GetObject(Such)
      Set pqo = pq
      Select Case pqo.Status
        Case ADS_JOB_PAUSED
          LV.ListItems.Item(i).SubItems(1) = "Pause"
        Case ADS_JOB_ERROR
          LV.ListItems.Item(i).SubItems(1) = "Error"
        Case ADS_JOB_DELETING
          LV.ListItems.Item(i).SubItems(1) = "Löscht"
        Case ADS_JOB_PRINTING
          LV.ListItems.Item(i).SubItems(1) = "Druckt"
        Case ADS_JOB_OFFLINE
          LV.ListItems.Item(i).SubItems(1) = "ist Offline"
        Case ADS_JOB_PAPEROUT
          LV.ListItems.Item(i).SubItems(1) = "Papier fehlt"
        Case ADS_JOB_PRINTED
          LV.ListItems.Item(i).SubItems(1) = "Drucken fertig"
        Case ADS_JOB_DELETED
          LV.ListItems.Item(i).SubItems(1) = "Löschen fertig"
        Case Else
          LV.ListItems.Item(i).SubItems(1) = "wartet"
      End Select
    End If
 
  Next
Exit Sub
Cleanup:
    If (Err.Number <> 0) Then
        MsgBox ("An error has occurred. " & Err.Number)
        MsgBox (Err.Description)
         LV.ListItems.Item(i).SubItems(1) = "Fehler"
    End If
    Set pq = Nothing
    Set pqo = Nothing
    Resume Next  
End Sub

dbayerTo be is to do (Rene Descartes)To do is to be (Kant / Nietzsche / Sartre u.a.)Do be do be dooo (Frank Sinatra, Strangers in the Night)