以编程方式检索打印机功能

打印机集合和 Printer 对象仅允许设置或检索打印机的设置。 要确定打印机的功能（如打印机支持的纸张种类或纸盒），必须调用 Windows 应用程序编程接口 (API) DeviceCapabilities 函数。 详细介绍此内容超出了本主题的范围，但PrinterDemo.mdb示例下载的 modPrinters 模块中的以下代码示例演示了如何检索打印机支持的纸张大小和纸箱的名称和 ID。

下面的代码应粘贴到模块的常规声明节。

' 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 = 0 

下面的过程使用 DeviceCapabilities API 函数显示一个消息框，其中包含默认打印机的名称以及它所支持的纸张大小的列表。

Sub GetPaperList() 
    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 the 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. 
    strMsg = "Papers available for " & strDeviceName & vbCrLf 
    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) 
         
        ' Add a paper number and name to text string for the message box. 
        strMsg = strMsg & vbCrLf & aintNumPaper(lngCounter) _ 
            & vbTab & strPaperName 
             
    Next lngCounter 
         
    ' Show the paper names in a message box. 
    MsgBox Prompt:=strMsg 
 
GetPaperList_End: 
    Exit Sub 
     
GetPaperList_Err: 
    MsgBox Prompt:=Err.Description, Buttons:=vbCritical & vbOKOnly, _ 
        Title:="Error Number " & Err.Number & " Occurred" 
    Resume GetPaperList_End 
     
End Sub

下面的过程使用 DeviceCapabilities API 函数显示一个消息框，其中包含默认打印机的名称以及它所支持的纸盒的列表。

Sub GetBinList(strName 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(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 = "Paper bins available for " & strDeviceName & vbCrLf 
    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) 
 
        ' 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. 
    MsgBox Prompt:=strMsg 
     
GetBinList_End: 
    Exit Sub 
GetBinList_Err: 
    MsgBox Prompt:=Err.Description, Buttons:=vbCritical & vbOKOnly, _ 
        Title:="Error Number " & Err.Number & " Occurred" 
    Resume GetBinList_End 
End Sub

支持和反馈

有关于 Office VBA 或本文档的疑问或反馈？ 请参阅 Office VBA 支持和反馈，获取有关如何接收支持和提供反馈的指南。