以下程序可供参考:
Option Explicit
    
Private Declare Function OpenPrinter Lib "winspool.drv" Alias _
    "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, _
    ByVal pDefault As Long) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" ( _
    ByVal hPrinter As Long) As Long
Private Declare Function DeviceCapabilities Lib "winspool.drv" _
    Alias "DeviceCapabilitiesA" (ByVal lpsDeviceName As String, _
    ByVal lpPort As String, ByVal iIndex As Long, lpOutput As Any, _
    ByVal dev As Long) As LongPrivate Const DC_PAPERNAMES = 16        ' Value obtained from wingdi.hSub GetPaperList()
' Display a message box with the name of the active printer and a list
' of papers it supports.    Dim lPaperCount As Long
    Dim lCounter As Long
    Dim hPrinter As Long
    Dim sDeviceName As String
    Dim sDevicePort As String
    Dim sPaperNamesList As String
    Dim sNextString As String
    Dim sTextString As String
    Dim iNumPaper() As Integer
    
    GetPrinterNameAndPort sDeviceName, sDevicePort
    
    If OpenPrinter(sDeviceName, hPrinter, 0) <> 0 Then        ' Get count of paper names supported by active printer.
        lPaperCount = DeviceCapabilities(sDeviceName, _
            sDevicePort, _
            DC_PAPERNAMES, _
            ByVal vbNullString, 0)
        ReDim iNumPaper(1 To lPaperCount)
        sPaperNamesList = String(64 * lPaperCount, 0)        ' Get paper names supported by active printer.
        lPaperCount = DeviceCapabilities(sDeviceName, _
            sDevicePort, _
            DC_PAPERNAMES, _
            ByVal sPaperNamesList, 0)
    
        ' List available paper names.
        sTextString = "Paper available for " & ActivePrinter
        For lCounter = 1 To lPaperCount
        
            ' Get a paper name.
            sNextString = Mid(sPaperNamesList, _
                64 * (lCounter - 1) + 1, 64)
            sNextString = Left(sNextString, _
                InStr(1, sNextString, Chr(0)) - 1)            ' Have one paper name.
            sNextString = String(6 - Len(CStr(iNumPaper(lCounter))), _
                " ") & sNextString
            
            ' Add paper name to text string for message box.
            sTextString = sTextString & Chr(13) & sNextString
            
        Next lCounter
        
        ClosePrinter (hPrinter)
        
        ' Show paper names in message box.
        MsgBox sTextString
        
    Else
        MsgBox ActivePrinter & " <Unavailable>"
        
    End IfEnd SubPrivate Sub GetPrinterNameAndPort(printerName As String, _
                                  printerPort As String)
' ActivePrinter yields a name of the form "Printer XYZ on LPT1" while the
' DeviceCapabilities function requires a printer name and port.
'
' Out:
'    printerName    Printer name derived from ActivePrinter property
'    printerPort    Printer port derived from ActivePrinter property    Dim sString As String
    Const searchText As String = " on "
    
    sString = ActivePrinter
    printerName = Left(sString, InStr(1, sString, searchText) - 1)
    printerPort = Right(sString, _
        Len(sString) - Len(printerName) - Len(searchText))End Sub 
Option ExplicitPrivate 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 LongPrivate Const DC_BINS = 6
Private Const DC_BINNAMES = 12Private Sub Command1_Click()
   Dim prn As Printer
   Dim dwbins As Long
   Dim ct As Long
   Dim nameslist As String
   Dim nextString As String
   Dim numBin() As Integer   Text1.Font.Name = "Courier New"
   Text1.Font.Size = 12
   Text1.Text = ""
   For Each prn In Printers
        dwbins = DeviceCapabilities(prn.DeviceName, prn.Port, _
          DC_BINS, ByVal vbNullString, 0)
        ReDim numBin(1 To dwbins)
        nameslist = String(24 * dwbins, 0)
        dwbins = DeviceCapabilities(prn.DeviceName, prn.Port, _
          DC_BINS, numBin(1), 0)
        dwbins = DeviceCapabilities(prn.DeviceName, prn.Port, _
          DC_BINNAMES, ByVal nameslist, 0)
        If Text1.Text <> "" Then
           Text1.Text = Text1.Text & vbCrLf & vbCrLf
        End If
        Text1.Text = Text1.Text & prn.DeviceName
        For ct = 1 To dwbins
           nextString = Mid(nameslist, 24 * (ct - 1) + 1, 24)
           nextString = Left(nextString, InStr(1, nextString, _
             Chr(0)) - 1)
           nextString = String(6 - Len(CStr(numBin(ct))), " ") & _
           numBin(ct) & "  " & nextString
           Text1.Text = Text1.Text & vbCrLf & nextString
        Next ct
   Next prn
End SubPrivate Sub Form_Load()
   ' Size and position the Form and controls
   Me.Height = 7000
   Me.Width = 7000
   Text1.Top = 100
   Text1.Left = 100
   Text1.Height = 6450
   Text1.Width = 5000
   Text1.Text = ""   ' Clear the TextBox
   Command1.Left = 5300
   Command1.Top = 1000
   Command1.Width = 1500
   Command1.Caption = "List Bins"
End Sub 
****************************************************************
Welcome to www.easthot.net (Programer's web)
****************************************************************