Generate Installed printer list with port & status details & access printer properties:

[arko24x7]

Hi guys,
Can anybody help me with this where i am loading a full list of installed printer in a listbox on a userform , but i also want to show in my multi column list box the port name & online/offline status of the respective printers. I used the following API function to generate the list:

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


Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" ( _
    ByVal HKey As Long) As Long


Private Declare PtrSafe 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


Private Declare PtrSafe 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






Public Function GetPrinterFullNames() As String()
Dim Printers() As String ' array of names to be returned
Dim PNdx As Long    ' index into Printers()
Dim HKey As Long    ' registry key handle
Dim Res As Long     ' result of API calls
Dim Ndx As Long     ' index for RegEnumValue
Dim ValueName As String ' name of each value in the printer key
Dim ValueNameLen As Long    ' length of ValueName
Dim DataType As Long        ' registry value data type
Dim ValueValue() As Byte    ' byte array of registry value value
Dim ValueValueS As String   ' ValueValue converted to String
Dim CommaPos As Long        ' position of comma character in ValueValue
Dim ColonPos As Long        ' position of colon character in ValueValue
Dim M As Long               ' string index


' registry key in HCKU listing printers
Const PRINTER_KEY = "Software\Microsoft\Windows NT\CurrentVersion\Devices"


PNdx = 0
Ndx = 0
' assume printer name is less than 256 characters
ValueName = String$(256, Chr(0))
ValueNameLen = 255
' assume the port name is less than 1000 characters
ReDim ValueValue(0 To 999)
' assume there are less than 1000 printers installed
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, ValueName, _
    ValueNameLen, 0&, DataType, ValueValue(0), 1000)
' loop until all values have been enumerated
Do Until Res = ERROR_NO_MORE_ITEMS
    M = InStr(1, ValueName, Chr(0))
    If M > 1 Then
        ' clean up the ValueName
        ValueName = Left(ValueName, M - 1)
    End If
    ' find position of a comma and colon in the port name
    CommaPos = InStr(1, ValueValue, ",")
    ColonPos = InStr(1, ValueValue, ":")
    ' ValueValue byte array to ValueValueS string
    On Error Resume Next
    ValueValueS = Mid(ValueValue, CommaPos + 1, ColonPos - CommaPos)
    On Error GoTo 0
    ' next slot in Printers
    PNdx = PNdx + 1
    Printers(PNdx) = ValueName & " on " & ValueValueS
    ' reset some variables
    ValueName = String(255, Chr(0))
    ValueNameLen = 255
    ReDim ValueValue(0 To 999)
    ValueValueS = vbNullString
    ' tell RegEnumValue to get the next registry value
    Ndx = Ndx + 1
    ' get the next printer
    Res = RegEnumValue(HKey, Ndx, ValueName, ValueNameLen, _
        0&, DataType, ValueValue(0), 1000)
    ' test for error
    If (Res <> 0) And (Res <> ERROR_MORE_DATA) Then
        Exit Do
    End If
Loop
' shrink Printers down to used size
ReDim Preserve Printers(1 To PNdx)
Res = RegCloseKey(HKey)
GetPrinterFullNames = Printers
End Function

Is there any other function that I can declare to get printer port name & status in that list box. Also if I want access any particuler printer properties from the list what will be my code?

 

[pbornemeier]

This site: Check if Default Printer online, if so print to it else select another
provided the following code to return status of the default printer:

Sub Test()
    Dim strComputer As String
    Dim objWMIService
    Dim colInstalledPrinters
    Dim objPrinter
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" _
                                  & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Set colInstalledPrinters = objWMIService.ExecQuery _
                               ("Select * from Win32_Printer where Default = 'True'")
    For Each objPrinter In colInstalledPrinters
        Select Case objPrinter.printerstatus
        Case 3
            MsgBox "Printer is Idle"
        Case 4
            MsgBox "Printer is Printing"
        Case 5
            MsgBox "Printer is Warming up"
        Case Else
            MsgBox "Printer is off line"
        End Select
    Next
End Sub

There are some minor complications, so be sure to read the thread on that site.

The previous API you posted was from Chip Pearson's site: Printers In VBA

 

[arko24x7]

Yes, & thanks to Chip Person's site for that... things happening right now is i can access the printer properties or set active printer, not both from the same list box. Because, to set printer active printer, printer name has to be like 'HP LaserJet *#$2 on Ne00 or Ne02 or whatever' but to gain access the printer properties you need only the printer name not 'on Ne00 or 01' ​sh*t. But for Status.. let me try first. Thanks to u in advance.

 

[pbornemeier]

I played around with the code I sent and modified it a bit:

Option Explicit

Sub PrinterListAndStatus()

    Dim strComputer As String
    Dim objWMIService
    Dim colInstalledPrinters
    Dim objPrinter
    Dim objProperty
    Dim objProperties
    Dim sDefault As String
    
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" _
                                  & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Set colInstalledPrinters = objWMIService.ExecQuery _
                               ("Select * from Win32_Printer where Default = 'True'")
    For Each objPrinter In colInstalledPrinters
        sDefault = objPrinter.Name
    Next
    
    Set colInstalledPrinters = objWMIService.ExecQuery _
                               ("Select * from Win32_Printer")
                               
    For Each objPrinter In colInstalledPrinters
        Debug.Print
        If objPrinter.Name = sDefault Then Debug.Print "########### DEFAULT PRINTER ###############"
        Debug.Print "Caption: " & objPrinter.Caption
        Debug.Print "Status: " & objPrinter.Status
        Select Case objPrinter.PrinterStatus
        Case 3
            Debug.Print "PrinterStatus: Printer is Idle" & " (" & objPrinter.PrinterStatus & ")"
        Case 4
            Debug.Print "PrinterStatus: Printer is Printing" & " (" & objPrinter.PrinterStatus & ")"
        Case 5
            Debug.Print "PrinterStatus: Printer is Warming up" & " (" & objPrinter.PrinterStatus & ")"
        Case Else
            Debug.Print "PrinterStatus: Printer is off line" & " (" & objPrinter.PrinterStatus & ")"
        End Select
        Debug.Print "PrinterState: " & objPrinter.PrinterState
        Debug.Print "PortName: " & objPrinter.PortName
        Debug.Print "Name: " & objPrinter.Name
        Debug.Print "Location: " & objPrinter.Location
        
        'For Each objProperty In objPrinter.Properties
            'debug.Print objProperties.Caption
        'Next
        
    Next
End Sub

Interesting code here: Determining Printer Behavior with WMI and Visual Studio 2012
It includes many enumerations of Printer properties.

If you put a Stop immediately after: For Each objPrinter In colInstalledPrinters
You can inspect the many properties associated with objPrinter in the Locals window

If you know how to iterate each of the properties without specifically listing them (my 3rd or 4th weak try is the commented out section) please update that here.

I took a printer offline and left the door open on another, but did not see a change in the output of this code. i am not sure how often the winmgmts object is updated from network peripherals.