Option Explicit

Private Declare Function SendMessage Lib "user32" Alias _
    "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, lParam As Any) As Long

Private Declare Function DeviceCapabilities Lib "winspool.drv" _
   Alias "DeviceCapabilitiesA" (ByVal lpDeviceName As String, _
   ByVal lpPort As String, ByVal iIndex As Long, lpOutput _
   As Any, ByVal dev As Long) As Long

Private Const LB_SETTABSTOPS = &H192
Private Const DC_BINS = 6
Private Const DC_BINNAMES = 12

Dim x As Integer

Private Sub Form_Load()
  For x = 0 To Printers.Count - 1
    Combo1.AddItem Printers(x).DeviceName
  Next x
  Combo1.ListIndex = 0
End Sub

Private Sub Combo1_Click()
  Dim prn As Printer

  If Combo1.ListIndex > -1 Then
    For Each prn In Printers
      If prn.DeviceName = Combo1.List(Combo1.ListIndex) Then
        BinsErmitteln prn
        Exit For
      End If
    Next prn
  End If
End Sub

Private Sub BinsErmitteln(prn As Printer)
  Dim bins As Long
  Dim binList As String
  Dim binNum() As Integer
  Dim binString As String

  ReDim a&(1)

  List1.Clear
  a(0) = 140

  SendMessage List1.Hwnd, LB_SETTABSTOPS, 1, a(0)

  bins = DeviceCapabilities(prn.DeviceName, prn.Port, _
        DC_BINS, ByVal vbNullString, 0)
  ReDim binNum(1 To bins)

  binList = String(24 * bins, 0)
  bins = DeviceCapabilities(prn.DeviceName, prn.Port, _
        DC_BINS, binNum(1), 0)
  bins = DeviceCapabilities(prn.DeviceName, prn.Port, _
        DC_BINNAMES, ByVal binList, 0)

  For x = 1 To bins
    binString = Mid(binList, 24 * (x - 1) + 1, 24)
    binString = Left(binString, InStr(1, binString, Chr(0)) - 1)
    List1.AddItem binString & Chr$(9) & binNum(x)
  Next x

  List1.ListIndex = 0
End Sub