Hello all,

I have need to find the current printer name and port number and change to a different printer and then change it back.
The code I have listed below works on windows 8.1, Windows 7 and Windows XP, However it does not work on Windows 10. I get an Automation error.

So I am looking for an alternate way to do this or a work around.


Sub ChangePrinter()
Dim CurrentPrinter As String
Dim XPSPrinterPort As String

'Ensure that Printer is always the same for everyone by finding Current Printer
'Then finding printer port of Microsoft XPS Document Writer and set as Acitve Printer
'The FindPrinter jumps to a function and runs that code and returns the printer name and prot.

   
    CurrentPrinter = Application.ActivePrinter
    XPSPrinterPort = FindPrinter("Microsoft XPS Document Writer")
    Application.ActivePrinter = XPSPrinterPort
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        Application.DefaultFilePath & "\" & SheetNameTemp & " Time Sheet" & ".pdf" _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
        
'Set Printer back to users current one
    Application.ActivePrinter = CurrentPrinter
    
End Sub
'The code below is something I found on the internet. Implemented into our system Mar 2014

'Written: November 28, 2009
'Author:  Leith Ross
'Summary: Finds a printer by name and returns the printer name and port number.
'Epscan added this code to projects in order to get everyone saving documents in same format.

Function FindPrinter(ByVal PrinterName As String) As String

 'This works with Windows 2000 and up
 
  Dim Arr As Variant
  Dim Device As Variant
  Dim Devices As Variant
  Dim Printer As String
  Dim RegObj As Object
  Dim RegValue As String
  Const HKEY_CURRENT_USER = &H80000001
       
    Set RegObj = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    RegObj.enumvalues HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Devices, Arr
    
      For Each Device In Devices
        RegObj.getstringvalue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Device, RegValue
        Printer = Device & " on " & Split(RegValue, ",")(1)
        If InStr(1, Printer, PrinterName, vbTextCompare) > 0 Then
           FindPrinter = Printer
           Exit Function
        End If
      Next
      
End Function