3 Replies Latest reply on Jan 15, 2018 9:05 AM by Andrea Orlando

    VBA Printer Device Capabilities

    Andrea Orlando

      I want to create a macro that list printer and the relative capabilities (paper size and paper bin).

       

      I have found this article: https://msdn.microsoft.com/en-us/vba/access-vba/articles/programmatically-retrieve-printer-capabilities

       

      but this code don't work:

       

      strDeviceName = Application.Printer.DeviceName

      strDevicePort = Application.Printer.Port

       

      There is a workaround ?

       

      (I get the list of printer by GetProfileString API)

        • Re: VBA Printer Device Capabilities
          Josh Brady

          The article you linked is inside MS Access help.  Those are not standard VBA calls available wherever you may find VBA.  The "Application" in the lines of code you have pasted above has to be Access (similar methods may exist for other MS Office apps, not sure).  Have you tested those lines of code running inside Access?

          • Re: VBA Printer Device Capabilities
            Andrea Orlando

            I solved !

             

            ' Declaration for the DeviceCapabilities function API call.
            Private Declare PtrSafe 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
            
            
            ' ******************************************************************************
            ' The following procedure uses the DeviceCapabilities API function to display a
            ' message box with the name of the default printer and a list of the paper sizes
            ' it supports.
            ' ******************************************************************************
            Function GetPaperList(strName As String, ByRef vArrayValue As Variant, ByRef vArrayAlias As Variant) As Boolean
                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 = strName '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.
                If lngPaperCount < 1 Then Exit Function
                ReDim aintNumPaper(1 To lngPaperCount)
                
                ReDim vArrayValue(1 To lngPaperCount)
                ReDim vArrayAlias(1 To lngPaperCount)
                For lngCounter = 1 To lngPaperCount
                    vArrayValue(lngCounter) = ""
                    vArrayAlias(lngCounter) = ""
                Next lngCounter
                
                ' 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
                    
                    vArrayValue(lngCounter) = aintNumPaper(lngCounter)
                    vArrayAlias(lngCounter) = strPaperName
                Next lngCounter
            
            
                GetPaperList = True
                
                ' Show the paper names in a message box.
                'MsgBox Prompt:=strMsg
            
            
            GetPaperList_End:
                Exit Function
            
            
            GetPaperList_Err:
                GetPaperList = False
                MsgBox Prompt:=Err.Description, Buttons:=vbCritical & vbOKOnly, _
                    Title:="GetPaperList(): ERRORE NUMERO " & Err.Number
                Resume GetPaperList_End
            
            
            End Function
            
            
            ' ******************************************************************************
            ' The following procedure 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.
            ' ******************************************************************************
            Function GetBinList(strName As String, ByRef vArrayValue As Variant, ByRef vArrayAlias As Variant) As Boolean
                ' 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 = strName '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.
                If lngBinCount < 1 Then Exit Function
                ReDim aintNumBin(1 To lngBinCount)
            
            
                ReDim vArrayValue(1 To lngBinCount)
                ReDim vArrayAlias(1 To lngBinCount)
                For lngCounter = 1 To lngBinCount
                    vArrayValue(lngCounter) = ""
                    vArrayAlias(lngCounter) = ""
                Next lngCounter
                
                ' 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
            
            
                    vArrayValue(lngCounter) = aintNumBin(lngCounter)
                    vArrayAlias(lngCounter) = strBinName
                Next lngCounter
            
            
                GetBinList = True
                
                ' Show paper bin numbers and names in message box.
                'MsgBox Prompt:=strMsg
            
            
            GetBinList_End:
                Exit Function
                
            GetBinList_Err:
                GetBinList = False
                MsgBox Prompt:=Err.Description, Buttons:=vbCritical & vbOKOnly, _
                    Title:="GetBinList(): ERRORE NUMERO " & Err.Number
                Resume GetBinList_End
            End Function