Setting Default Printer Through VBA

Question

I'm running an Excel macro that switches between two printers, one named "RecOffice_Pink", the other named "RecOffice_White".

This is a hacky workaround to the problem of VBA not having a way to easily specify a tray to print from. The Pink printer has all but one tray disabled, which contains our pink paper.

I am using

CreateObject(WScript.Network).SetDefaultPrinter "RecOffice_Pink"
and
CreateObject(WScript.Network).SetDefaultPrinter "RecOffice_White"

This works beautifully on our Windows 7 computers, however it doesn't seem to work on any of our Windows 10 PCs.

There are no errors thrown, no messages created, it just doesn't seem to be switching the printer.

I have tried setting them up as Shared printers on our network, setting them up per computer, both of which work well on Windows 7.

Answer 1

Usage

  SetDefaultPrinter "RecOffice_Pink"

Set Default Printer

 Sub SetDefaultPrinter(PrinterName As String, Optional ComputerName As String = ".")
    Dim Printer As Object, Printers As Object, WMIService As Object
    Set WMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & ComputerName & "\root\cimv2")
    Set Printers = WMIService.ExecQuery("Select * from Win32_Printer Where Name = '" & PrinterName & "'")

    For Each Printer In Printers
        Printer.SetDefaultPrinter
    Next

End Sub

List Printer and Printer Properties in New Workbook

Sub ListPrinters(Optional ComputerName As String = ".")
    Dim WMIService As Object
    Set WMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & ComputerName & "\root\cimv2")

    Dim Printers As Object
    Set Printers = WMIService.ExecQuery("Select * from Win32_Printer")

    Dim Printer As Object
    Dim Item As Object
    Dim Results
    Dim r As Long, c As Long, NameIndex As Long
    For Each Printer In Printers
        ReDim Results(1 To Printers.Count + 1, 1 To Printer.Properties_.Count)
        r = 1
        For Each Item In Printer.Properties_
            c = c + 1
            If Item.Name = "Name" Then NameIndex = c
            Results(r, c) = Item.Name
        Next
        Exit For
    Next

    For Each Printer In Printers
        r = r + 1
        c = 0
        For Each Item In Printer.Properties_
            c = c + 1
            Results(r, c) = Item.Value
        Next
    Next

    Dim SheetsInNewWorkbook As Long
    SheetsInNewWorkbook = Application.SheetsInNewWorkbook
    Application.SheetsInNewWorkbook = 2
    With Workbooks.Add
        With Worksheets(1)
            .Range("A1").Resize(UBound(Results), UBound(Results, 2)).Value = Results
            .Columns(NameIndex).Cut
            .Columns(1).Insert Shift:=xlDown
            .ListObjects.Add(xlSrcRange, .Range("A1").CurrentRegion, , xlYes).Unlist
            .Columns.AutoFit
            .Range("A1").CurrentRegion.Copy
        End With
        With Worksheets(2)
            .Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            Application.CutCopyMode = False
            .Columns.AutoFit
        End With
    End With
    Application.SheetsInNewWorkbook = SheetsInNewWorkbook
End Sub