Code:
Option Compare Database
Option Explicit
Public intPass As Integer
' Declaration for the DeviceCapabilities function API call.
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 lpDevMode As Long) As Long
' DeviceCapabilities function constants.
Private Const DC_PAPERNAMES = 16
Private Const DC_PAPERS = 2
Private Const DC_BINNAMES = 12
Private Const DC_BINS = 6
Private Const DEFAULT_VALUES = 0Sub GetBinList(strPrinter As String)
' 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.
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
On Error GoTo GetBinList_Err
' Get name and port of the default printer.
strDeviceName = Application.Printers(strPrinter).DeviceName
strDevicePort = Application.Printers(strPrinter).Port
' Get count of paper bin names supported by printer.
lngBinCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _
lpPort:=strDevicePort, _
iIndex:=DC_BINNAMES, _
lpOutput:=ByVal vbNullString, _
lpDevMode:=DEFAULT_VALUES)
' Re-dimension 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 printer.
lngBinCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _
lpPort:=strDevicePort, _
iIndex:=DC_BINNAMES, _
lpOutput:=ByVal strBinNamesList, _
lpDevMode:=DEFAULT_VALUES)
' Get array of paper bin numbers supported by printer
lngBinCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _
lpPort:=strDevicePort, _
iIndex:=DC_BINS, _
lpOutput:=aintNumBin(1), _
lpDevMode:=0)
' List available paper bin names.
If lngBinCount > 0 Then
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(Start:=1, _
String1:=strBinName, String2:=Chr(0)) - 1
strBinName = Left(String:=strBinName, _
Length:=intLength)
' populate the Paper Bin Combo box with a list of available bins
If intPass = 1 Then
Forms!frmAfdrukkenOp.cboPTrayA4.AddItem Item:=strBinName
End If
If intPass = 2 Then
Forms!frmAfdrukkenOp.cboPTrayEnvelop.AddItem Item:=strBinName
End If
Next lngCounter
End If
GetBinList_End:
Exit Sub
GetBinList_Err:
MsgBox Prompt:=Err.Description, Buttons:=vbCritical & vbOKOnly, _
title:="Error Number " & Err.Number & " Occurred"
Resume GetBinList_End
End Sub
Sub GetPaperList()
' Uses DeviceCapabilities API function to display a message box
' with the name of the default printer and a list of
' the papers it supports.
Dim lngPaperCount As Long
Dim lngCounter As Long
Dim hPrinter As Long
Dim strDeviceName As String
Dim strDevicePort As String
Dim strPaperNamesList As String
Dim strPaperName As String
Dim intLength As Integer
Dim strMsg As String
Dim aintNumPaper() As Integer
On Error GoTo GetPaperList_Err
' Get the name and port of the default printer.
strDeviceName = Application.Printer.DeviceName
strDevicePort = Application.Printer.Port
' Get the count of paper names supported by printer.
lngPaperCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _
lpPort:=strDevicePort, _
iIndex:=DC_PAPERNAMES, _
lpOutput:=ByVal vbNullString, _
lpDevMode:=DEFAULT_VALUES)
' Re-dimension the array to the count of paper names.
ReDim aintNumPaper(1 To lngPaperCount)
' Pad the variable to accept 64 bytes for each paper name.
strPaperNamesList = String(64 * lngPaperCount, 0)
' Get the string buffer of all paper names supported by the printer.
lngPaperCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _
lpPort:=strDevicePort, _
iIndex:=DC_PAPERNAMES, _
lpOutput:=ByVal strPaperNamesList, _
lpDevMode:=DEFAULT_VALUES)
' Get the array of all paper numbers supported by the printer.
lngPaperCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _
lpPort:=strDevicePort, _
iIndex:=DC_PAPERS, _
lpOutput:=aintNumPaper(1), _
lpDevMode:=DEFAULT_VALUES)
' List the available paper names.
For lngCounter = 1 To lngPaperCount
' Parse a paper name from the string buffer.
strPaperName = Mid(String:=strPaperNamesList, _
Start:=64 * (lngCounter - 1) + 1, Length:=64)
intLength = VBA.InStr(Start:=1, String1:=strPaperName, String2:=Chr(0)) - 1
strPaperName = Left(String:=strPaperName, Length:=intLength)
' populate the Paper Size Combo box with a list of available paper sizes
' Forms!frmPrinter.cboPaperSize.AddItem Item:=strPaperName
Next lngCounter
GetPaperList_End:
Exit Sub
GetPaperList_Err:
MsgBox Prompt:=Err.Description, Buttons:=vbCritical & vbOKOnly, _
title:="Error Number " & Err.Number & " Occurred"
Resume GetPaperList_End
End Sub
Windows 7 32bit 
Access 2010 32bit
Reply With Quote
Originally Posted by Intruder1500
