How to set active printer to microsoft print to pdf without the "on XXXX:"

user_2770315 0
Viewed 421

I'm needing to set my printer to "Microsoft Print to PDF" but how would I know which port it will be on? It could be different on another machine. I need to it to be able to set it without knowing the port "on XXXX:" part like this:

Application.activeprinter = "Microsoft Print to PDF"

Any help would be appreciated. Thanks

?ActivePrinter 'show active printer "XXXXXX on XXXX:"
vba
1 Answers
  1. The simplest way:

Try manually printing (anything) from Excel on the above printer.

Then use the next code line: Debug.Print Application.ActivePrinter. It will return in Immediate Window the printer name string (port included) to be used in case of setting it as Active.

  1. The next code returns the printer with its port, being called with printer name as argument:
Function FindPrinter(ByVal PrinterName As String) As String
  Dim arrH, Pr, Printers, Printer As String
  Dim RegObj As Object, 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", Printers, arrH
    
      For Each Pr In Printers
        RegObj.getstringvalue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Pr, RegValue
        Printer = Pr & " on " & Split(RegValue, ",")(1)
        If InStr(1, Printer, PrinterName, vbTextCompare) > 0 Then
           FindPrinter = Printer
           Exit Function
        End If
      Next
End Function

It can be called in the next way:

Sub testFindPrinter()
    Debug.Print Application.ActivePrinter
    Debug.Print FindPrinter("Microsoft Print to PDF")
End Sub

Or, simple set the active printer in the next way:

Application.ActivePrinter = FindPrinter("Microsoft Print to PDF")

Edited:

I did not know that the suffix before the printer port should/can be regionalized. Thanks to @T.M. I know now. In such a case the function can be updated with the next way of this suffix string extraction:

   Dim suff As String, arrSuff
   arrSuff = Split(Application.ActivePrinter, " ")
   suff = arrSuff(UBound(arrSuff) - 1)
user_22333080
Related