Excel 365 VBA - Printer Ports not Static

[RStasicky]

Hello,

I have been researching for about 2 weeks now and I have not been able to find a solution that I was able to make work (I'm sure it is me).
I created a simple print menu for employees to choose Printer1, Printer2, or Printer3. The rest of the code cannot proceed unless a printer has been selected.
The basic issue is that the printer port changes on these "autologin" computers that we use in the production floor. If I do NOT add the printer port in the code, it will not print.
The code works without issue EXCEPT the changing printer port

Sub PrintM1()
'
' PrintForm Macro
' Prints to Specified Printer

'Set Printer Name
Dim q As Long
Dim PrinterName As String


PrinterName = "\\pvmtowfs20\MA54_M1BOOTH on Ne12:"
Application.ActivePrinter = PrinterName


'Set Print Properties (Black & White)
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Work Order #1")

With ws.PageSetup
.BlackAndWhite = True
End With


'Print Document
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
Msg = "Roll Inventory Form Printed Successfully"

PrintCounter = 1


End Sub

********************************************************************************

Sub PrintM3()
'
' PrintForm Macro
' Prints to Specified Printer

'Set Printer Name
Dim q As Long
Dim PrinterName As String

PrinterName = "\\pvmtowfs20\MA47_PRODM3BOOTH on Ne07:"
' PrinterName = "Adobe PDF on Ne06:"
Application.ActivePrinter = PrinterName


'Set Print Properties (Black & White)
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Work Order #1")

With ws.PageSetup
.BlackAndWhite = True
End With


'Print Document
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
Msg = "Roll Inventory Form Printed Successfully"

PrintCounter = 1


End Sub

********************************************************************************

Sub PrintTL()
'
' PrintForm Macro
' Prints to Specified Printer

'Set Printer Name
Dim q As Long
Dim PrinterName As String


PrinterName = "\\pvmtowfs20\MA48_PRODOFF on Ne08:"
' PrinterName = "Adobe PDF on Ne06:"
Application.ActivePrinter = PrinterName

' PrinterName = "\\pvmtowfs20\MA54_M1BOOTH on Ne12:"
' Application.ActivePrinter = PrinterName


'Set Print Properties (Black & White)
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Work Order #1")

With ws.PageSetup
.BlackAndWhite = True
End With


'Print Document
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
Msg = "Roll Inventory Form Printed Successfully"

PrintCounter = 1


End Sub

 

[John_w]

With this function you pass the name of a printer and it returns the full printer name including its network port.

'Written: November 28, 2009
'Author:  Leith Ross
'Summary: Finds a printer by name and returns the printer name and port number.

Public 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  'original code
        If StrComp(Device, printerName, vbTextCompare) = 0 Then
            FindPrinter = printer
            Exit Function
        End If
    Next
      
End Function

Call it like this from your code:

    printerName = FindPrinter("\\pvmtowfs20\MA48_PRODOFF")

I'm not sure if it works with network printers, though.

 

[RStasicky]

With this function you pass the name of a printer and it returns the full printer name including its network port.

'Written: November 28, 2009
'Author:  Leith Ross
'Summary: Finds a printer by name and returns the printer name and port number.

Public 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  'original code
        If StrComp(Device, printerName, vbTextCompare) = 0 Then
            FindPrinter = printer
            Exit Function
        End If
    Next
     
End Function

Call it like this from your code:

    printerName = FindPrinter("\\pvmtowfs20\MA48_PRODOFF")

I'm not sure if it works with network printers, though.

Thank you, thank you, thank you!

This does seem to work in my test environment. I will roll it out into production tomorrow when I am back in the office, but all indications are that this absolutely works perfectly.
I truly appreciate your guidance.

 

[RStasicky]

It does not appear as though my follow up posted. This failed in my real world application (outside of my test environment). My test environment is my company issues laptop that I connected via VPN and also in office. Your solution worked perfectly on my equipment. When I rolled it out to production on a shared, autologin computer, it could not validate the printer name / port. I am assuming that the shared workstation does not have the same admin rights as I do on my laptop.

Your solution worked, so I appreciate that, but now I have to come up with an alternative solution.

 

[John_w]

Yes, it's likely the failure is due to insufficient permissions to access the Windows Management Instrument (WMI) service - the Set RegObj = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv") line - or read the Registry.

There is a good explanation of the above WMI string here:

Explain VBScript WMI query / impersonationLevel, etc

Dim strComputer, objReg, ScriptName, strKeyPath, strValueName, strValue Const HKEY_LOCAL_MACHINE = &H80000002 strComputer = "." Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!...

stackoverflow.com

With the VBA macro, GetObject is a native VBA object, rather than a VBScript component that the above page uses.