List of available Printers in Windows using VBA code example

Printers

In this article lets build a simple PoC which will find all available printers in Windows and loads in a listbox on a User Form control using Excel VBA.

Prerequisites

• Create a User Form
• Put following controls on it
  • GroupBox
  • ListBox
  • Button to Print
  • Button to Close
• Create a user module and name it “modPrinter“

modPrinter module code

Option Explicit
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKCU = HKEY_CURRENT_USER
Private Const KEY_QUERY_VALUE = &H1&
Private Const ERROR_NO_MORE_ITEMS = 259&
Private Const ERROR_MORE_DATA = 234
#If win7 Then
    Private Declare PtrSafe Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal HKey As LongPtr, _
        ByVal lpSubKey As String, _
        ByVal ulOptions As LongPtr, _
        ByVal samDesired As LongPtr, _
        phkResult As LongPtr) As LongPtr
#Else
    Private Declare Function RegOpenKeyEx Lib "advapi32" _
        Alias "RegOpenKeyExA" ( _
        ByVal HKey As Long, _
        ByVal lpSubKey As String, _
        ByVal ulOptions As Long, _
        ByVal samDesired As Long, _
        phkResult As Long) As Long
#End If
#If win7 Then
    Private Declare PtrSafe Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" ( _
        ByVal HKey As LongPtr, _
        ByVal dwIndex As LongPtr, _
        ByVal lpValueName As String, _
        lpcbValueName As LongPtr, _
        ByVal lpReserved As LongPtr, _
        lpType As LongPtr, _
        lpData As Byte, _
        lpcbData As LongPtr) As LongPtr
#Else
    Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" ( _
        ByVal HKey As Long, _
        ByVal dwIndex As Long, _
        ByVal lpValueName As String, _
        lpcbValueName As Long, _
        ByVal lpReserved As Long, _
        lpType As Long, _
        lpData As Byte, _
        lpcbData As Long) As Long
#End If
#If win7 Then
    Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" (ByVal HKey As LongPtr) As LongPtr
#Else
    Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal HKey As Long) As Long
#End If

Public Function FindPrinters() As String()
    Dim Printers() As String
    Dim PNdx As Long
    Dim HKey As Long
    Dim Res As Long
    Dim Ndx As Long
    Dim oPrinterName As String
    Dim oPrinterNameLen As Long
    Dim oDataType As Long
    Dim oPort() As Byte
    Dim oPortyArray As String
    Dim CommaPos As Long
    Dim ColonPos As Long
    Dim M As Long
    
    ' Registry key constant
    Const PRINTER_KEY = "Software\Microsoft\Windows NT\CurrentVersion\Devices"
    
    PNdx = 0
    Ndx = 0
    ' Printer name should be less than 256 characters
    oPrinterName = String$(256, Chr(0))
    oPrinterNameLen = 255
    
    'Port should be < 1000 characters
    ReDim oPort(0 To 999)
    'Consider MAX List of printers < 1000
    ReDim Printers(1 To 1000)
    
    ' open the key whose values enumerate installed printers
    Res = RegOpenKeyEx(HKCU, PRINTER_KEY, 0&, _
        KEY_QUERY_VALUE, HKey)
    ' start enumeration loop of printers
    Res = RegEnumValue(HKey, Ndx, oPrinterName, _
        oPrinterNameLen, 0&, oDataType, oPort(0), 1000)
    ' loop until all values have been enumerated
    Do Until Res = ERROR_NO_MORE_ITEMS
        M = InStr(1, oPrinterName, Chr(0))
        If M > 1 Then
            ' clean up the oPrinterName
            oPrinterName = Left(oPrinterName, M - 1)
        End If
        ' find position of a comma and colon in the port name
        CommaPos = InStr(1, oPort, ",")
        ColonPos = InStr(1, oPort, ":")
        ' oPort byte array to oPortyArray string
        On Error Resume Next
        oPortyArray = Mid(oPort, CommaPos + 1, ColonPos - CommaPos)
        On Error GoTo 0
        ' next slot in Printers
        PNdx = PNdx + 1
        Printers(PNdx) = oPrinterName & " on " & oPortyArray
        ' reset  variables
        oPrinterName = String(255, Chr(0))
        oPrinterNameLen = 255
        ReDim oPort(0 To 999)
        oPortyArray = vbNullString
        'get the next registry value
        Ndx = Ndx + 1
        ' get the next printer
        Res = RegEnumValue(HKey, Ndx, oPrinterName, oPrinterNameLen, _
            0&, oDataType, oPort(0), 1000)
        ' Check error
        If (Res <> 0) And (Res <> ERROR_MORE_DATA) Then
            Exit Do
        End If
    Loop
    
    ReDim Preserve Printers(1 To PNdx)
    Res = RegCloseKey(HKey)
    'Outoupt
    FindPrinters = Printers
End Function

Load printers in ListBox

Private Sub UserForm_Initialize()
    Dim oListPrinters() As String
    Dim i As Long
    Dim oPrinterName As String
    oListPrinters = FindPrinters()
    For i = LBound(oListPrinters) To UBound(oListPrinters)
        lstPrinters.AddItem oListPrinters(i)
    Next i
End Sub

Change default printer

Private Sub lstPrinters_Click()
    'Set default printer with selected printer in listbox
    Application.ActivePrinter = lstPrinters.Text
End Sub

Calling User Form

Public Sub PrinterExample()
    UserForm1.Show
End Sub

Attach macro

Create one shape on the sheet then right click and choose Assign Macro… command and select “PrinterExample” from the list of Macro Dialog and say OK.

Output

Please leave your comments or queries under comment section also please do subscribe to our blogs to keep your self upto date.

Share on Facebook

Tweet