How to set Excel’s ActivePrinter using VBA?

2015/02/27 by Frans

Recently I wanted to change Excel’s ActivePrinter using VBA. That isn’t as straightforward as I expected it to be. In particular there is a localization issue.

At startup Excel will set Application.ActivePrinter to your default printer, in my case usually a Laserjet. I wanted to use VBA to set the ActivePrinter temporarily to my PDFCreator printer. I expected that this would do it:

Application.ActivePrinter = “PDFCreator”

Unfortunately VBA gave me a runtime error 1004.

The problem

I typed ?Application.ActivePrinter in the immediate window and got as reply:

Brother HL-4150CDN op Ne06:

Excel not only wants to know the printer name but also the port name of the printer, which can be something like Ne01, LPT1, Nul or any IP address.

How to get the port of a printer?

A google on “excel activeprinter port” gave solutions like:

Configure the printer ports in Windows. And do that on all machines of all users? No way!
In a loop set the ActivePrinter to every possible port name until it doesn’t fail. Sounds a little bit better. Unfortunately it is not obvious to create a list of all possible port names. No go.
Use Application.Dialogs(xlDialogPrinterSetup) and ask the user to select the printer. Would be fine, but I don’t want to bother the user with this.
Use API functions to retrieve all your installed printers and there port names from the registry. Yes!

On Chip Pearson’s site I found Listing Printers In VBA.
On Experts Exchange Rory Archibald gave a solution based on WMI, which I use below.

Localization issue

Unfortunately both solutions use a hard coded English “on” to create the full printer name, as in “PDFCreator on Ne01:”. So they won’t work with a German (auf), Spanish (en), French (sur) or Dutch Windows (op). I expected there would be a Locale constant for this but I couldn’t find it.
I almost decided to hard code the string for the above mentioned languages when I realized that the solution is already there. Just take the current ActivePrinter value, split it and the last but one item in the array is your locale “on”. Simple.
Remaining question: is it possible that a windows installation has no printer installed? I don’t know, but in that case the code below will probably fail.

Function GetPrinterFullName

Running the test procedure below resulted on my Dutch Windows machine in:

Default printer:            Brother HL-4150CDN op Ne06:
Temp printer:               PDFCreator op Ne01:
Default printer:            Brother HL-4150CDN op Ne06:

This is the code to test the function:

Private Sub test_GetPrinterFullName()
    Dim sPrinter As String
    Dim sDefaultPrinter As String
    Debug.Print "Default printer: ", Application.ActivePrinter
    sDefaultPrinter = Application.ActivePrinter ' store default printer
    sPrinter = GetPrinterFullName("PDFCreator")
    If sPrinter = vbNullString Then ' no match
        Debug.Print "No match"
    Else
        Application.ActivePrinter = sPrinter
        Debug.Print "Temp printer: ", Application.ActivePrinter
        ' do something with the temp printer
        Application.ActivePrinter = sDefaultPrinter
    End If
    Debug.Print "Default printer: ", Application.ActivePrinter
End Sub

And this is the function:

Public Function GetPrinterFullName(Printer As String) As String

    ' This function returns the full name of the first printerdevice that matches Printer.
    ' Full name is like "PDFCreator on Ne01:" for a English Windows and like
    ' "PDFCreator sur Ne01:" for French.
    ' Created: Frans Bus, 2015. See http://pixcels.nl/set-activeprinter-excel
    ' see http://blogs.msdn.com/b/alejacma/archive/2008/04/11/how-to-read-a-registry-key-and-its-values.aspx
    ' see http://www.experts-exchange.com/Software/Microsoft_Applications/Q_27566782.html

    Const HKEY_CURRENT_USER = &H80000001
    Dim regobj As Object
    Dim aTypes As Variant
    Dim aDevices As Variant
    Dim vDevice As Variant
    Dim sValue As String
    Dim v As Variant
    Dim sLocaleOn As String
    
    ' get locale "on" from current activeprinter
    v = Split(Application.ActivePrinter, Space(1))
    sLocaleOn = Space(1) & CStr(v(UBound(v) - 1)) & Space(1)
    
    ' connect to WMI registry provider on current machine with current user
    Set regobj = GetObject("WINMGMTS:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    
    ' get the Devices from the registry
    regobj.EnumValues HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", aDevices, aTypes
    
    ' find Printer and create full name
    For Each vDevice In aDevices
        ' get port of device
        regobj.GetStringValue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", vDevice, sValue
        ' select device
        If Left(vDevice, Len(Printer)) = Printer Then ' match!
            ' create localized printername
            GetPrinterFullName = vDevice & sLocaleOn & Split(sValue, ",")(1)
            Exit Function
        End If
    Next
    
    ' at this point no match found
    GetPrinterFullName = vbNullString

End Function

Final note

I checked Application.Activeprinter in Word en Powerpoint. Guess what, they don’t need to know the portname…

I hope this pixcel helps. Excel!

Comments

anonimo italiano says

2017/11/22 at 12:25

Hello, I made a small change to get the first printer that contains PDF (or XPS, or what-else). In this way you shouldn’t care about the proper name installed in your (or customer) machine, but just run it! Thanks.

Public Function GetPrinterFullName(Optional PrinterType As String = “PDF”) As String

‘ This function returns the full name of the first printerdevice that matches Printer.
‘ Full name is like “PDFCreator on Ne01:” for a English Windows and like
‘ “PDFCreator sur Ne01:” for French.
‘ Created: Frans Bus, 2015. See https://pixcels.nl/set-activeprinter-excel
‘ see https://blogs.msdn.com/b/alejacma/archive/2008/04/11/how-to-read-a-registry-key-and-its-values.aspx
‘ see https://www.experts-exchange.com/Software/Microsoft_Applications/Q_27566782.html

Const HKEY_CURRENT_USER = &H80000001
Dim regobj As Object
Dim aTypes As Variant
Dim aDevices As Variant
Dim vDevice As Variant
Dim sValue As String
Dim v As Variant
Dim sLocaleOn As String

‘ get locale “on” from current activeprinter
v = Split(Application.ActivePrinter, Space(1))
sLocaleOn = Space(1) & CStr(v(UBound(v) – 1)) & Space(1)

‘ connect to WMI registry provider on current machine with current user
Set regobj = GetObject(“WINMGMTS:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv”)

‘ get the Devices from the registry
regobj.EnumValues HKEY_CURRENT_USER, “Software\Microsoft\Windows NT\CurrentVersion\Devices”, aDevices, aTypes

‘ find Printer and create full name
For Each vDevice In aDevices
‘ get port of device
regobj.GetStringValue HKEY_CURRENT_USER, “Software\Microsoft\Windows NT\CurrentVersion\Devices”, vDevice, sValue
‘ select device
If InStr(vDevice, PrinterType) 0 Then ‘ match!
‘ create localized printername
Debug.Print vDevice, sLocaleOn, sValue
GetPrinterFullName = vDevice & sLocaleOn & Split(sValue, “,”)(1)
Exit Function
End If
Next

‘ at this point no match found
GetPrinterFullName = vbNullString

End Function
jjz says

2017/07/13 at 20:54

This is really helpful, thanks!
Robert says

2017/06/27 at 20:11

Thanks for the suggestion, it works ok on my pc, but unfortunately I am having a couple of problems.
1) on one pc the instruction

regobj.EnumValues HKEY_CURRENT_USER, “Software\Microsoft\Windows NT\CurrentVersion\Devices”, aDevices, aTypes

fails with a runtime error, unregistered library. Does it need a particular library? I could not find any difference with my pc, where there is no such problem.

2) I could not manage to have the code work with a shared printer connected to another PC. The name of the printer, as seen with the debugger, is “\\USER1\Samsung 1860 series on Ne07:” same as found in the registry, but when I try to use it with the instruction
.Application.ActivePrinter = sPrinter
I get a runtime error 5216, error with the printer.

Any ideas? Thanks again
noname says

2017/06/17 at 14:43

i can not speak english very well but may be help. i can fix my run time error 1004 problem. excel wants printer name same like “Ne07: uzerindeki Godex G530 “, but codes giving “Ne07: uzerindeki Godex G530″. firs look i can not see difference. when i add ” ” (one click spacebar) codes work fine

“Ne07: uzerindeki Godex G530” wrong
“Ne07: uzerindeki Godex G530 ” true

this code edited for tukish language because, original codes giving this “Godex G530 on Ne07:” , but turkish office wants “Ne07: uzerindeki Godex G530 ”

i guess other languages offices has a same problem.

Dim Printers() As String
Dim Printer As String
Dim N As Long
Printers = GetPrinterFullNames()
SON = 1

For N = LBound(Printers) To UBound(Printers)
Sheets(“Sheet1”).Range(“F” & SON) = Printers(N)
Sheets(“Sheet1”).Range(“G” & SON) = Mid(Sheets(“Sheet1”).Range(“F” & SON), WorksheetFunction.Search(“Ne”, Sheets(“Sheet1”).Range(“F” & SON), 1), 5) & ” üzerindeki ” & Mid(Sheets(“Sheet1”).Range(“F” & SON), 1, (WorksheetFunction.Search(“on”, Sheets(“Sheet1”).Range(“F” & SON), 1) – 1))
SON = SON + 1
Next N

For barkodyazici = 1 To SON
On Error Resume Next
If WorksheetFunction.Search(“Godex”, Sheets(“Sheet1”).Range(“G” & SON), 1) > 0 Then
Application.ActivePrinter = Sheets(“Sheet1”).Range(“G” & barkodyazici)
End If
Next barkodyazici

ActiveWindow.SelectedSheets.PrintOut Copies:=1
Vladimir says

2016/12/26 at 12:42

Litle bit modify your code. Now it’s really universal. I hope)))

Public Function GetPrinterFullName(printer As String) As String

‘ This function returns the full name of the first printerdevice that matches Printer.
‘ Full name is like “PDFCreator on Ne01:” for a English Windows and like
‘ “PDFCreator sur Ne01:” for French.
‘ Created: Frans Bus, 2015. See https://pixcels.nl/set-activeprinter-excel
‘ see https://blogs.msdn.com/b/alejacma/archive/2008/04/11/how-to-read-a-registry-key-and-its-values.aspx
‘ see https://www.experts-exchange.com/Software/Microsoft_Applications/Q_27566782.html

Const HKEY_CURRENT_USER = &H80000001
Dim regobj As Object
Dim aTypes As Variant
Dim aDevices As Variant
Dim vDevice As Variant
Dim sValue As String
Dim v() As String

Dim obprinter As Object
Dim allprinters As Object
Dim i As Byte
Dim port As String

Set allprinters = GetObject(“winmgmts://./root/CIMV2”).ExecQuery(“SELECT * FROM Win32_Printer”, , 48)
For Each obprinter In allprinters
i = i + 1
If ActivePrinter Like “*” & obprinter.Name & “*” Then
port = Replace(ActivePrinter, obprinter.Name, “”)
Exit For
End If
Next

‘ connect to WMI registry provider on current machine with current user
Set regobj = GetObject(“WINMGMTS:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv”)

‘ get the Devices from the registry
regobj.EnumValues HKEY_CURRENT_USER, “Software\Microsoft\Windows NT\CurrentVersion\Devices”, aDevices, aTypes

‘ find Printer and create full name
For Each vDevice In aDevices
‘ get port of device
regobj.GetStringValue HKEY_CURRENT_USER, “Software\Microsoft\Windows NT\CurrentVersion\Devices”, vDevice, sValue
‘ select device
If Left(vDevice, Len(printer)) = printer Then ‘ match!
‘ create localized printername
GetPrinterFullName = vDevice & Split(port, “Ne”)(0) & Left(Split(sValue, “,”)(1), 4) & Mid(Split(port, “Ne”)(1), 3)
Exit Function
End If
Next

‘ at this point no match found
GetPrinterFullName = vbNullString

End Function
Vladimir says

2016/12/26 at 08:09

Ha-ha-ha)) Yes and this code doesn’t work in russian Excel. Becouse ActivePrinter looks like – PDFCreator (Ne02:). Without any “On” an with brackets! So your code not such universal)
Vladimir says

2016/12/25 at 16:15

Solved that my problem – added the line
ThisWorkbook.Activate
before
Application.ActivePrinter = sPrinter
Vladimir says

2016/12/25 at 15:44

Doesn’t work in Russia in English 2016 Excel. Error 1004 in line:
Application.ActivePrinter = sPrinter
:(((
Owen says

2016/09/07 at 05:58

Thanks very much for this! Has made maintaining a bit of code here much simpler.
Lewis Metzger says

2016/08/24 at 16:21

Thank you Fran Bus. Just what I was looking for. I have 32 bit Windows API code that gets the device names and works well locally, but needs additional work for network printers.

Your code is simply brilliant.

Thanks again.

Lewis Metzger
Fair Lawn, New Jersey (United State)