• Skip to primary navigation
  • Skip to main content
  • Skip to primary sidebar

Pixcels.nl

  • Home
  • Categories
    • Excel apps
    • Pivottable stuff
    • PowerBI stuff
    • RGS en auditfiles
    • Sheet stuff
    • Userform stuff
    • VBA stuff
    • VBE stuff
    • XML stuff
  • About
You are here: Home / Categories / VBA stuff / How to set Excel’s ActivePrinter using VBA?

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!

Filed Under: VBA stuff Tagged With: ActivePrinter, VBA

Reader Interactions

Comments

  1. 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

  2. jjz says

    2017/07/13 at 20:54

    This is really helpful, thanks!

  3. 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

  4. 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

  5. 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

  6. 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)

  7. Vladimir says

    2016/12/25 at 16:15

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

  8. Vladimir says

    2016/12/25 at 15:44

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

  9. Owen says

    2016/09/07 at 05:58

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

  10. 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)

Primary Sidebar

Recent posts

  • The Grand Totals range of a pivottable in Excel
  • Replace drill-through for Power Pivot and Power BI pivottables in Excel
  • AuditfileValidator for Excel: validate and inspect Xml auditfiles
  • SAF-T auditfiles for test and development
  • Een postcodetabel op basis van BAG Extract 2.0

Recent comments

  • Harry Cuntapay on Replace drill-through for Power Pivot and Power BI pivottables in Excel
  • Lucio on Disable Shift key on open
  • Lucio on Disable Shift key on open
  • Julius Peter on The sequence of events in workbooks
  • Ben on The sequence of events in workbooks

Categories

Tags

ActiveControl ActivePrinter ADCS auditfiles BAG Connection Custom tab Database Debug Direct Debit drill-through Events event trapping Focus IBAN ISO 21378 MDI MSXML Multiple Document Interface normalize PAIN.008 PivotTable postcode Power BI RGS Ribbon SAF-T schema SEPA SOM Table Userforms validate VBA XAF xml XPath

Copyright © 2023 · eleven40 Pro on Genesis Framework · WordPress · Log in