Microsoft KB Archive/244639

= OFF2000: Macro to Obtain a List of Paper Names Supported by the Active Printer =

Article ID: 244639

Article Last Modified on 10/11/2006

-

APPLIES TO


 * Microsoft Excel 2000 Standard Edition
 * Microsoft Word 2000 Standard Edition

-



This article was previously published under Q244639





SUMMARY
There is no built-in feature in Microsoft Visual Basic for Applications to obtain a list of paper names (Letter, Legal, A4, and so forth) supported by the active printer. This article contains Visual Basic for Applications sample code that returns the paper names supported by the active printer.



MORE INFORMATION
Microsoft provides programming examples for illustration only, without warranty either expressed or implied. This includes, but is not limited to, the implied warranties of merchantability or fitness for a particular purpose. This article assumes that you are familiar with the programming language that is being demonstrated and with the tools that are used to create and to debug procedures. Microsoft support engineers can help explain the functionality of a particular procedure, but they will not modify these examples to provide added functionality or construct procedures to meet your specific requirements. The following sample code displays a list of paper names supported by the active printer. 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 Long

Private Const DC_PAPERNAMES = 16       ' Value obtained from wingdi.h

Sub 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 & " " End If

End Sub

Private 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

