VBA – WMI – Gather Information & Configure Printers Cont’d

So, I’ve recently been on a WMI Printer kick! 🙂

VBA - WMI - Deleting A Printer

Just a short post today to demonstrate how easy it is to delete a printer from a PC executing some simple WMI code via VBA. If you follow my blog at all, by now you are fully aware that WMI can easily retrieve information regarding pretty much any aspect of your PC: Hardware, Software, Events,…

Continue reading →

VBA - WMI - Configure A Printer

Earlier in the week, I demonstrated that WMI can be use for more than just retrieve information about a PC. What about configuring different aspects of your PC! That’s right, WMI can do that too.

So let’s do one more article and share a little more of some of what can be done, things like:

Get Information About The Printer And Drivers
Get The PC’s Default Printer
Set A Printer As The Default Printer
Rename A Printer

Get Information About The Printer And Drivers

'---------------------------------------------------------------------------------------
' Procedure : WMI_Printers_GetInfo
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Display information about the PC's Printers
'               Look at the references below for a full listing of all the available
'               Properties (there are a lot more!)
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Early Binding -> Microsoft WMI Scripting VX.X Library
'             Late Binding  -> None required
' References:
'   https://learn.microsoft.com/en-us/windows/win32/cimwin32prov/win32-printer
'   https://learn.microsoft.com/en-us/windows/win32/cimwin32prov/win32-printerdriver
'
' Usage:
' ~~~~~~
' ? WMI_Printers_GetInfo
'   Returns -> A listing in the VBE Immediate Window
'
' Revision History:
' Rev       Date(yyyy-mm-dd)        Description
' **************************************************************************************
' 1         2023-03-06
'---------------------------------------------------------------------------------------
Public Function WMI_Printers_GetInfo()
    On Error GoTo Error_Handler
    #Const WMI_EarlyBind = False    'True => Early Binding / False => Late Binding
    #If WMI_EarlyBind = True Then
        Dim oWMI              As WbemScripting.SWbemServices
        Dim oCols             As WbemScripting.SWbemObjectSet
        Dim oCol              As WbemScripting.SWbemObject
        Dim oDrivers          As WbemScripting.SWbemObjectSet
        Dim oDriver           As WbemScripting.SWbemObject
    #Else
        Dim oWMI              As Object
        Dim oCols             As Object
        Dim oCol              As Object
        Dim oDrivers          As Object
        Dim oDriver           As Object
        Const wbemFlagReturnImmediately = 16    '(&H10)
        Const wbemFlagForwardOnly = 32          '(&H20)
    #End If
    Dim sWMIQuery             As String         'WMI Query

    Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    sWMIQuery = "SELECT * FROM Win32_Printer"
    Set oCols = oWMI.ExecQuery(sWMIQuery, , wbemFlagReturnImmediately Or wbemFlagForwardOnly)
    For Each oCol In oCols
        With oCol
            Debug.Print .DeviceId, .Default, .Local, .Location, .Status;
        End With

        sWMIQuery = "Associators of " & _
                    "{Win32_Printer.DeviceID='" & oCol.Name & "'} " & _
                    "WHERE AssocClass = Win32_DriverForDevice Role=Antecedent"
        Set oDrivers = oWMI.ExecQuery(sWMIQuery)
        For Each oDriver In oDrivers
            With oDriver
                Debug.Print , .DriverPath
            End With
        Next
    Next

Error_Handler_Exit:
    On Error Resume Next
    Set oCol = Nothing
    Set oCols = Nothing
    Set oWMI = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: WMI_Printers_GetInfo" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

Get The PC’s Default Printer

'---------------------------------------------------------------------------------------
' Procedure : WMI_Printer_GetDefault
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Get the PC's Default Printer
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Early Binding -> Microsoft WMI Scripting VX.X Library
'             Late Binding  -> None required
'
' Usage:
' ~~~~~~
' ? WMI_Printer_GetDefault("")
'   Returns -> HP Smart Tank 5101
'
' Revision History:
' Rev       Date(yyyy-mm-dd)        Description
' **************************************************************************************
' 1         2023-03-06
'---------------------------------------------------------------------------------------
Public Function WMI_Printer_GetDefault() As String
    On Error GoTo Error_Handler
    '#Const WMI_EarlyBind = False    'True => Early Binding / False => Late Binding
    #If WMI_EarlyBind = True Then
        Dim oWMI              As WbemScripting.SWbemServices
        Dim oCols             As WbemScripting.SWbemObjectSet
        Dim oCol              As WbemScripting.SWbemObject
    #Else
        Dim oWMI              As Object
        Dim oCols             As Object
        Dim oCol              As Object
    #End If
    Dim sWMIQuery             As String

    Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    sWMIQuery = "SELECT DeviceId FROM Win32_Printer WHERE Default = True"

    'Option 1
    Set oCols = oWMI.ExecQuery(sWMIQuery, , wbemFlagReturnImmediately Or wbemFlagForwardOnly)
    For Each oCol In oCols
        WMI_Printer_GetDefault = oCol.DeviceId
        Exit For
    Next

    '    'Option 2
    '    Set oCols = oWMI.ExecQuery(sWMIQuery)
    '    If oCols.Count > 0 Then WMI_Printer_GetDefault = oCols.ItemIndex(0).DeviceId

Error_Handler_Exit:
    On Error Resume Next
    Set oCol = Nothing
    Set oCols = Nothing
    Set oWMI = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Source: WMI_Printer_SetAsDefault" & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

Set A Printer As The Default Printer

'---------------------------------------------------------------------------------------
' Procedure : WMI_Printer_SetAsDefault
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Set the specified printer as the Default Printer
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Early Binding -> Microsoft WMI Scripting VX.X Library
'             Late Binding  -> None required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sPrinterName  : Name of the printer to change the configuration of
'
' Usage:
' ~~~~~~
' ? WMI_Printer_SetAsDefault("Microsoft Print to PDF")
'   Returns -> True, if successful
'              False, if function failed for some reason
'
' Revision History:
' Rev       Date(yyyy-mm-dd)        Description
' **************************************************************************************
' 1         2023-03-06
'---------------------------------------------------------------------------------------
Public Function WMI_Printer_SetAsDefault(ByVal sPrinterName As String) As Boolean
    On Error GoTo Error_Handler
    #Const WMI_EarlyBind = False    'True => Early Binding / False => Late Binding
    #If WMI_EarlyBind = True Then
        Dim oWMI              As WbemScripting.SWbemServices
        Dim oPrinter          As WbemScripting.SWbemObject
    #Else
        Dim oWMI              As Object
        Dim oPrinter          As Object
    #End If
    Dim lRetVal               As Long

    Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    Set oPrinter = oWMI.Get("Win32_Printer.DeviceID='" & sPrinterName & "'")
    lRetVal = oPrinter.SetDefaultPrinter

    If lRetVal = 0 Then WMI_Printer_SetAsDefault = True
    'lRetval => 0 = Success, <>0 = unsuccessful

Error_Handler_Exit:
    On Error Resume Next
    Set oPrinter = Nothing
    Set oWMI = Nothing
    Exit Function

Error_Handler:
    If Err.Number <> -2147217406 Then    'Printer Not found
        MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
               "Error Source: WMI_Printer_SetAsDefault" & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Description: " & Err.Description & _
               Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
               , vbOKOnly + vbCritical, "An Error has Occurred!"
    End If
    Resume Error_Handler_Exit
End Function

Rename A Printer

'---------------------------------------------------------------------------------------
' Procedure : WMI_Printer_Rename
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Rename a printer
'               Some printers can't be renamed, ie: "Microsoft Print to PDF"
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Early Binding -> Microsoft WMI Scripting VX.X Library
'             Late Binding  -> None required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sPrinterName      : Name of the printer to change the name of
' sNewPrinterName   : New name to give the printer
'
' Usage:
' ~~~~~~
' WMI_Printer_Rename("HP Smart Tank 5101", "Color Printer")
'   Returns -> True, change was successful
'              False, an error occurred, change was unsuccessful
'
' Revision History:
' Rev       Date(yyyy-mm-dd)        Description
' **************************************************************************************
' 1         2023-03-06
'---------------------------------------------------------------------------------------
Public Function WMI_Printer_Rename(ByVal sPrinterName As String, _
                                   ByVal sNewPrinterName As String) As Boolean
    On Error GoTo Error_Handler
    #Const WMI_EarlyBind = False    'True => Early Binding / False => Late Binding
    #If WMI_EarlyBind = True Then
        Dim oWMI              As WbemScripting.SWbemServices
        Dim oPrinter          As WbemScripting.SWbemObject
    #Else
        Dim oWMI              As Object
        Dim oPrinter          As Object
    #End If
    Dim lRetVal               As Long

    Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    Set oPrinter = oWMI.Get("Win32_Printer.DeviceID='" & sPrinterName & "'")
    lRetVal = oPrinter.RenamePrinter((sNewPrinterName))

    If lRetVal = 0 Then WMI_Printer_Rename = True
    'lRetval => 0 = Success, 5 = Access Denies, 1801 = Invalid Printer Name

Error_Handler_Exit:
    On Error Resume Next
    Set oPrinter = Nothing
    Set oWMI = Nothing
    Exit Function

Error_Handler:
    If Err.Number <> -2147217406 Then    'Printer Not found
        MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
               "Error Source: WMI_Printer_Rename" & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Description: " & Err.Description & _
               Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
               , vbOKOnly + vbCritical, "An Error has Occurred!"
    End If
    Resume Error_Handler_Exit
End Function

One response on “VBA – WMI – Gather Information & Configure Printers Cont’d”

Robert Olson March 13, 2023 at 9:28 am

This great stuff. One of the long-standing wishes I have for my application is the ability to configure a printer and tray to use on a per-report basis (and bonus points for disabling duplexing on single-page reports to make printing quicker). These posts give me a handle on how to get there.