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.