2

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.

Marx
  • 106
  • 1
  • 10
  • 1
    In your Windows 10 printer settings, do you have the option set to "Let Windows Manage the Default Printer"? Try changing that. – braX Nov 19 '19 at 08:19
  • I have some code that does what you need. I'm just at breakfast. Give me a few minutes and I will look at what I used. – Andreas Nov 19 '19 at 08:23
  • I use a very similar code that you do. `CreateObject("WScript.Network").SetDefaultPrinter "\\PS02.samba.net\HELPS006"`. The only difference is that `WScript.Network` has `" "`. Not sure if that could be the problem. – Andreas Nov 19 '19 at 08:38
  • You could also add in workbook open lines to add the printers to the computer (if not installed) `Set WshNetwork = CreateObject("WScript.Network")` and `WshNetwork.AddWindowsPrinterConnection "\\PS02.samba.net\HELPS006"`. My printers are shared network printers. – Andreas Nov 19 '19 at 08:43
  • Your solution worked, braX! Turning the option off allowed the script to run normally. – Marx Nov 20 '19 at 21:02

1 Answers1

3

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
TinMan
  • 6,624
  • 2
  • 10
  • 20