' Prototypisierung der API-Funktion DeviceCapabilities
Private Declare Function DeviceCapabilities _
  Lib "winspool.drv" Alias "DeviceCapabilitiesA" ( _
  ByVal lpDeviceName As String, _
  ByVal lpPort As String, _
  ByVal iIndex As Long, _
  ByRef lpOutput As Any, _
  ByVal dev As Long _
  ) As Long
' Konstante für den Parameter iIndex
Private Const DC_BINS As Long = 6&
Private Const DC_BINNAMES As Long = 12&
 
Private Sub ListPaperBins()
Dim PaperBins() As String
Dim lBinCount As Long
Dim lBinNumbers() As Integer
Dim sBinNames As String
Dim lNullPos As Long
Dim i As Long
  With Printer
    ' Anzahl unterstützter Papierschächte ermitteln:
    lBinCount = DeviceCapabilities(.devicename, .port, _
                DC_BINS, ByVal vbNullString, 0)
    ' Speicherplatz für die Rückgaben reservieren
    ReDim lBinNumbers(1 To lBinCount)
    sBinNames = Space$(24 * lBinCount)
    ' Nummern vorhandener Papierschächte abholen:
    DeviceCapabilities .devicename, .port, DC_BINS, lBinNumbers(1), 0
    ' Namen der vorhandenen Papierschächte abholen:
    DeviceCapabilities .devicename, .port, DC_BINNAMES, ByVal sBinNames, 0
  End With
  ' Schachtnummern und -namen extrahieren
  ' und im zweidimensionalen Array PaperBins ablegen:
  ReDim PaperBins(0 To lBinCount - 1, 0 To 1)
  For i = 1 To lBinCount
    ' Schachtnummer:
    PaperBins(i - 1, 0) = lBinNumbers(i)
    ' Schachtname:
    PaperBins(i - 1, 1) = Mid$(sBinNames, 24 * (i - 1) + 1, 24)
    ' Im Bedarfsfall das Stringende kürzen:
    lNullPos = InStr(PaperBins(i - 1, 1), vbNullChar)
    If lNullPos > 0 Then
      PaperBins(i - 1, 1) = Left$(PaperBins(i - 1, 1), lNullPos - 1)
    End If
  Next i
  ' Die gefundenen Daten in das Direktfenster ausgeben:
  Debug.Print "Vorhandene Papierschächte des Druckers " _
              & Printer.devicename & " am Anschluss " _
              & Printer.port & " :"
  For i = LBound(PaperBins) To UBound(PaperBins)
    Debug.Print PaperBins(i, 0) & ": " & PaperBins(i, 1)
  Next i
End Sub