Help improve my variable network printer code?

[NessPJ]

Hey guys,

After some searching and experimenting i have found some code here, that would run in my Excel Sheet and find a network printer (independant of client desktops).

I have the code here:

    'The current default printer is defined and stored.    
    Dim DefaultPrinter As String
    DefaultPrinter = Application.ActivePrinter

    'This routine allows you to address a Network printer independant of the Desktop Client:
    Dim q As Long, xUNC As String
    On Error Resume Next
    For q = 0 To 99
    xUNC = Sheets("Admin").Range("B26").Value & Sheets("Admin").Range("B14").Value & " on Ne" & Format(q, "00") & ":"
    Application.ActivePrinter = xUNC
    If Err.Number = 0 Then 'if UNC is valid, print
    
    'The Page Setup for the printing assignment is defined here. Some settings are not available to default printers:
     With Sheets("VVAAH2").PageSetup
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = 1
    .LeftMargin = Application.InchesToPoints(0.708661417322835)
    .RightMargin = Application.InchesToPoints(0.708661417322835)
    .TopMargin = Application.InchesToPoints(0.15748031496063)
    .BottomMargin = Application.InchesToPoints(0.748031496062992)
    .HeaderMargin = Application.InchesToPoints(0.31496062992126)
    .FooterMargin = Application.InchesToPoints(0.31496062992126)
    .PaperSize = 342
    .CenterHorizontally = False
    .CenterVertically = False
    .Orientation = xlPortrait
    End With
    
    'Print de Pagina af met de correcte Netwerkprinter.
    Sheets("VVAAH2").PrintOut Copies:=1, ActivePrinter:= _
    xUNC
        
    Else
        Err.Clear
    End If
        Next q
        On Error GoTo 0

    'The stored default printer is selected again.
    Application.ActivePrinter = DefaultPrinter

The Server + Printername are referred to a Cell in my worksheet, so they can be parameter controlled (call it ready-for-the-future functionality).

Now i have noticed there are still some desktops which will not work because the Windows Network name still seems to deviate.
In this case i noticed the extension of the name was no longer " on Ne0"#:" but " on e0#:".

I was wondering if there was a way to make the VBA code above loop through both types of network names? Or i could rule out the "N" to be optional in the printer name somehow?

Thanks in advance!

 

[NessPJ]

Anyone?

 

[NessPJ]

Basically the code posted above will do the following right now:

Loop through:
    xUNC = Sheets("Admin").Range("B26").Value & Sheets("Admin").Range("B14").Value & " on Ne01":
    xUNC = Sheets("Admin").Range("B26").Value & Sheets("Admin").Range("B14").Value & " on Ne02:
    xUNC = Sheets("Admin").Range("B26").Value & Sheets("Admin").Range("B14").Value & " on Ne03:
    xUNC = Sheets("Admin").Range("B26").Value & Sheets("Admin").Range("B14").Value & " on Ne04:
Etc.

Until it hits the right printserver and the printing works (Err.Number becomes 1 and it exits).

What i would like for the code to do is the following:

Loop through:
    xUNC = Sheets("Admin").Range("B26").Value & Sheets("Admin").Range("B14").Value & " on Ne01":
    xUNC = Sheets("Admin").Range("B26").Value & Sheets("Admin").Range("B14").Value & " on e01":
    xUNC = Sheets("Admin").Range("B26").Value & Sheets("Admin").Range("B14").Value & " on Ne02":
    xUNC = Sheets("Admin").Range("B26").Value & Sheets("Admin").Range("B14").Value & " on e02":
    xUNC = Sheets("Admin").Range("B26").Value & Sheets("Admin").Range("B14").Value & " on Ne03":
    xUNC = Sheets("Admin").Range("B26").Value & Sheets("Admin").Range("B14").Value & " on e03":
Etc.

Until it hits the right printserver and the printing works (Err.Number becomes 1 and it exits).

Any help on how to do this please?
It seems like its the only thing left that prevents my printer code from working everwhere....

 

[Kyle123]

You don't need to rely on Errors to get the correct printer port. I wrote a post on it here, but Rory's solution is probably more versatile:

Public Function GetPrinterPort(strPrinterName As String) As String
   Dim objReg As Object, strRegVal As String, strValue As String
   Const HKEY_CURRENT_USER = &H80000001
   Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
   strRegVal = "Software\Microsoft\Windows NT\CurrentVersion\PrinterPorts\"
   objReg.getstringvalue HKEY_CURRENT_USER, strRegVal, strPrinterName, strValue
   GetPrinterPort = Split(strValue, ",")(1)
End Function

Which can be used:

MsgBox GetPrinterPort("\\Server\Printer Name")

 

[NessPJ]

Dear Kyle,

Thanks for your reply!

strPrinterName will be the entire printername independent of the client machine the user is on?

Before i try, any experience running this on virtual desktop environments (VDI) ?

 

[Kyle123]

No, it will return the port number for a printer. So the "NE01:" "NE02:" etc.

Nope, give it a whirl

 

[NessPJ]

Seems to be working on a virtual machine as well. Cool!

 

[NessPJ]

Dear Kyle,

Sadly the code seems to have worked once, but now i keep getting the following error message on other client machines:
View image: getprinterporterror

Any ideas what might be causing this?

 

[NessPJ]

I have some more detailed information about my problem, i hope you can help me.
Right now my code looks like this (Module1):

Public Function GetPrinterPort(strPrinterName As String) As String
   Dim objReg As Object, strRegVal As String, strValue As String
   Const HKEY_CURRENT_USER = &H80000001
   Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
   strRegVal = "Software\Microsoft\Windows NT\CurrentVersion\PrinterPorts\"
   objReg.getstringvalue HKEY_CURRENT_USER, strRegVal, strPrinterName, strValue
   GetPrinterPort = Split(strValue, ",")(1)
End Function

Dim Port, VVAPrinter As String
    Port = GetPrinterPort(Sheets("Admin").Range("B26").Value & Sheets("Admin").Range("B14").Value)
    VVAPrinter = Sheets("Admin").Range("B26").Value & Sheets("Admin").Range("B14").Value & " on " & Port
    Application.ActivePrinter = VVAPrinter

    'De Pagina instellingen van de af te drukken vrachtbrief worden elke maal gestuurd.
    With Sheets("VVAPA1").PageSetup
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = 1
    .LeftMargin = Application.InchesToPoints(0.708661417322835)
    .RightMargin = Application.InchesToPoints(0.708661417322835)
    .TopMargin = Application.InchesToPoints(0.15748031496063)
    .BottomMargin = Application.InchesToPoints(0.748031496062992)
    .HeaderMargin = Application.InchesToPoints(0.31496062992126)
    .FooterMargin = Application.InchesToPoints(0.31496062992126)
    .PaperSize = 342
    .CenterHorizontally = False
    .CenterVertically = False
    .Orientation = xlPortrait
    End With
    
    'Print de pagina met de correcte Netwerkprinter.
    Sheets("VVAPA1").PrintOut Copies:=1, ActivePrinter:=VVAPrinter

I keep getting a debug error on the orange line. Any help would be greatly appreciated!

 

[NessPJ]

Anyone?