14 April 2015

Programmatically Retrieve Printer Capabilities

Sub DebugGetBinList(strName As String)

    ' https://msdn.microsoft.com/en-us/library/bb258176%28v=office.12%29.aspx
    
    ' Uses the DeviceCapabilities API function to display a
    ' message box with the name of the default printer and a
    ' list of the paper bins it supports.
 
    ' Boso's version: output su Debug.Print()

    Dim lngBinCount As Long
    Dim lngCounter As Long
    Dim hPrinter As Long
    Dim strDeviceName As String
    Dim strDevicePort As String
    Dim strBinNamesList As String
    Dim strBinName As String
    Dim intLength As Integer
    Dim strMsg As String
    Dim aintNumBin() As Integer
    Dim riga As String
    riga = String(Len(strName) + 25, "-")
    
    On Error GoTo GetBinList_Err
    
    ' Get name and port of the default printer.
    strDeviceName = Application.Printers(strName).DeviceName
    strDevicePort = Application.Printers(strName).Port
    
    ' Get count of paper bin names supported by the printer.
    lngBinCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _
                                     lpPort:=strDevicePort, _
                                     iIndex:=DC_BINNAMES, _
                                     lpOutput:=ByVal vbNullString, _
                                     lpDevMode:=DEFAULT_VALUES)
    
    ' Re-dimension the array to count of paper bins.
    ReDim aintNumBin(1 To lngBinCount)
    
    ' Pad variable to accept 24 bytes for each bin name.
    strBinNamesList = String(Number:=24 * lngBinCount, Character:=0)

    ' Get string buffer of paper bin names supported by the printer.
    lngBinCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _
                                     lpPort:=strDevicePort, _
                                     iIndex:=DC_BINNAMES, _
                                     lpOutput:=ByVal strBinNamesList, _
                                     lpDevMode:=DEFAULT_VALUES)
        
    ' Get array of paper bin numbers supported by the printer.
    lngBinCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _
                                     lpPort:=strDevicePort, _
                                     iIndex:=DC_BINS, _
                                     lpOutput:=aintNumBin(1), _
                                     lpDevMode:=0)
    
    ' List available paper bin names.
    strMsg = ""
    strMsg = strMsg & vbCrLf
    strMsg = strMsg & "Paper bins available for " & strDeviceName & vbCrLf
    strMsg = strMsg & vbCrLf & riga & vbCrLf
    strMsg = strMsg & "ID  Name"
    strMsg = strMsg & vbCrLf & riga
    
    For lngCounter = 1 To lngBinCount
        
        ' Parse a paper bin name from string buffer.
        strBinName = Mid(String:=strBinNamesList, _
                         Start:=24 * (lngCounter - 1) + 1, _
                         Length:=24)
        
        intLength = VBA.InStr(1, strBinName, Chr(0)) - 1
        
        strBinName = Left(strBinName, intLength)

        ' Add bin name and number to text string for message box.
        strMsg = strMsg & vbCrLf & aintNumBin(lngCounter) & vbTab & strBinName
        
    Next lngCounter
    
    ' Show paper bin numbers and names in message box.
    Debug.Print strMsg
    Debug.Print riga
    
GetBinList_End:
    Exit Sub

GetBinList_Err:
    MsgBox Prompt:=Err.Description, Buttons:=vbCritical & vbOKOnly, _
        Title:="Error Number " & Err.Number & " Occurred"
    Resume GetBinList_End

End Sub


Trovato qui.