Setting a specific printer in Excel

Juan Pablo González

MrExcel MVP
Joined
Feb 8, 2002
Messages
11,959
Hello guys, I had been dealing with this issue for a while, fonud a solution in google, by reconstructing code from here and there. The "Test" sub first returns an array of all installed printers, then, in the For Next loop, I look for the Acrobat Distiller printer, which is the one I'm interested right now. I call the SetActivePrinter from there, wich sets Excel's ActivePrinter to the right port, wich was the big issue.

I did the Loop JUST IN CASE, because I could just do the

SetActivePrinter "Acrobat Distiller"

Here's the code, all in a standard module. The example doesn't do much by itself, just assigns the ActivePrinter to the Distiller, and then restores the "old" printer back, but I'm just showing that it can be done with VBA.

Code:
Option Explicit

Const PRINTER_ENUM_CONNECTIONS = &H4
Const PRINTER_ENUM_LOCAL = &H2

Type PRINTER_INFO_1
    Flags As Long
    pDescription As String
    pName As String
    pComment As String
End Type

Private Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" _
        (ByVal Flags As Long, ByVal Name As String, ByVal Level As Long, _
        pPrinterEnum As Long, ByVal cdBuf As Long, pcbNeeded As Long, _
        pcReturned As Long) As Long

Private Declare Function PtrToStr Lib "Kernel32" Alias "lstrcpyA" _
        (ByVal RetVal As String, ByVal Ptr As Long) As Long

Private Declare Function StrLen Lib "Kernel32" Alias "lstrlenA" _
        (ByVal Ptr As Long) As Long

Declare Function GetProfileString& Lib "Kernel32" Alias "GetProfileStringA" _
        (ByVal lpApplicationName As String, ByVal lpKeyName As String, _
         ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer)

Sub Test()
    Dim a As Variant
    Dim st As String
    Dim i As Integer
    Dim port As Integer
    st = Application.ActivePrinter
    a = ListPrinters
    For i = LBound(a) To UBound(a)
        If InStr(1, a(i), "Distiller", 1) > 0 Then
            SetActivePrinter CStr(a(i))
            Exit For
        End If
    Next i
    MsgBox Application.ActivePrinter
    Application.ActivePrinter = st
End Sub

Private Function ListPrinters() As Variant
Dim bSuccess As Boolean
Dim iBufferRequired As Long
Dim iBufferSize As Long
Dim iBuffer() As Long
Dim iEntries As Long
Dim iIndex As Long
Dim strPrinterName As String
Dim iDummy As Long
Dim iDriverBuffer() As Long
Dim strPrinters() As String

iBufferSize = 3072
ReDim iBuffer((iBufferSize  4) - 1) As Long
bSuccess = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or PRINTER_ENUM_LOCAL, vbNullString, _
    1, iBuffer(0), iBufferSize, iBufferRequired, iEntries)
If bSuccess Then
    If iBufferRequired > iBufferSize Then
        iBufferSize = iBufferRequired
        Debug.Print "iBuffer too small.  Trying again with "; iBufferSize & " bytes."
        ReDim iBuffer(iBufferSize  4) As Long
        bSuccess = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or PRINTER_ENUM_LOCAL, vbNullString, _
                1, iBuffer(0), iBufferSize, iBufferRequired, iEntries)

        If Not bSuccess Then
            MsgBox "Error enumerating printers."
            Exit Function
        End If
    End If

    ReDim strPrinters(iEntries - 1)
    For iIndex = 0 To iEntries - 1
        strPrinterName = Space$(StrLen(iBuffer(iIndex * 4 + 2)))
        iDummy = PtrToStr(strPrinterName, iBuffer(iIndex * 4 + 2))
        strPrinters(iIndex) = strPrinterName
    Next iIndex
End If
ListPrinters = strPrinters
End Function

Private Sub SetActivePrinter(strPrinterName As String)
    Dim strBuffer As String
    Dim lngRetValue As Long
    Dim strDriverName As String
    Dim strPrinterPort As String
    
    strBuffer = Space(1024)
    
    lngRetValue = GetProfileString("PrinterPorts", strPrinterName, "", _
                                                    strBuffer, Len(strBuffer))
    
    ' Parse the driver name and port name out of the buffer
    GetDriverAndPort strBuffer, strDriverName, strPrinterPort
    
    If strDriverName <> "" And strPrinterPort <> "" Then
    ' Changed the " on " to " en " to suit Spanish needs...
    ' Application.ActivePrinter = strPrinterName & " on " & strPrinterPort
       Application.ActivePrinter = strPrinterName & " en " & strPrinterPort
    End If
End Sub

Private Sub GetDriverAndPort(ByVal buffer As String, DriverName As String, PrinterPort As String)
    Dim iDriver As Integer
    Dim iPort As Integer
    DriverName = ""
    PrinterPort = ""

    ' The driver name is first in the string terminated by a comma
    iDriver = InStr(buffer, ",")
    If iDriver > 0 Then

         ' Strip out the driver name
        DriverName = Left(buffer, iDriver - 1)

        ' The port name is the second entry after the driver name
        ' separated by commas.
        iPort = InStr(iDriver + 1, buffer, ",")

        If iPort > 0 Then
            ' Strip out the port name
            PrinterPort = Mid(buffer, iDriver + 1, _
            iPort - iDriver - 1)
        End If
    End If
End Sub
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Jaun,

While testing this nice piece of code I get the run-time error 1004 on following line:

<pre>
If strDriverName <> "" And strPrinterPort <> "" Then
Application.ActivePrinter = strPrinterName & " on " & strPrinterPort
End If
</pre>

Stepping through the code (F8) and using debug-print didn´t give anything...

Plattform Windows 2000 SP-3 / XL 2000 SR-1
(Swedish of course!)

Do You have any idea what´s might causing it?

Kind regards,
Dennis
 
Upvote 0
Dennis, this
<pre>& " on " &</pre>
is probably it. The "on" is something like "Acrobat Distiller on Ne01:", I had to modify it to work in my spanish version, because it reads "Acrobat Distiller en Ne01:", so, I'm guessing with your swedish version is the same thing...
 
Upvote 0
Another technique would involve prompting the user to select the desired printer using

application.Dialogs(xlDialogPrinterSetup).Show

saving it to a cell, or a registry setting.

I have had trouble with the "Ne Number" myself, since the company network isn't always reliable. We can go for weeks with all printer connections being established in the expected order. But when one connection isn't established in the expected sequence, the "Ne Number" changes, and that's when errors happen.


So, if a simple technique such as mine is called, have an On Error Goto statement in the module that will again call the application.Dialogs(xlDialogPrinterSetup).Show
method in order to determine the new name for the printer.


The reason that Excel expects the Ne Number (which could also be a port, such as LPT1) is to allow identical printers to be installed at various locations.

You know, if Microsoft would have/could have allowed default to just the printer name, when the name is unique, our lives would be so much easier.

So much of the VBA code has default values, default methods, etc. Why can't .ActivePrinter default to accepting a printer name without the Ne Number, IF the printer name is unique?
 
Upvote 0
Juan,

I'm guessing with your swedish version is the same thing...

Thanks - Yes and of course I should be aware of it :wink:

Steve,
Thanks for the insight and I agree about the unique names. Although I'm not a network-guy I think that it from a programlogical point of view is motivated, i e printername and portname.

But the largest drawback is that it´s language-specific, i e as Juan says....

Kind regards,
Dennis
 
Upvote 0
On 2002-09-21 08:43, XL-Dennis wrote:
Juan,

I'm guessing with your swedish version is the same thing...

Thanks - Yes and of course I should be aware of it :wink:

Steve,
Thanks for the insight and I agree about the unique names. Although I'm not a network-guy I think that it from a programlogical point of view is motivated, i e printername and portname.

But the largest drawback is that it´s language-specific, i e as Juan says....

Kind regards,
Dennis

You know what's even funnier about this ? I use Office 2000 at the office (Was on WinMe until last week), spanish version, but, Excel "needs" the "on" to be translated, but Word doesn't...

And yes Steve, that's the reliable way, but, not always the "best" way, from a user point of view... anyway, try the code above, it works pretty well... (Except on Acrobat, which is the one I really need !)
 
Upvote 0
On 2002-09-21 12:04, Juan Pablo G. wrote:
On 2002-09-21 08:43, XL-Dennis wrote:
Juan,

I'm guessing with your swedish version is the same thing...

Thanks - Yes and of course I should be aware of it :wink:

Steve,
Thanks for the insight and I agree about the unique names. Although I'm not a network-guy I think that it from a programlogical point of view is motivated, i e printername and portname.

But the largest drawback is that it´s language-specific, i e as Juan says....

Kind regards,
Dennis

You know what's even funnier about this ? I use Office 2000 at the office (Was on WinMe until last week), spanish version, but, Excel "needs" the "on" to be translated, but Word doesn't...

And yes Steve, that's the reliable way, but, not always the "best" way, from a user point of view... anyway, try the code above, it works pretty well... (Except on Acrobat, which is the one I really need !)

Juan, the code works Great. No issues with
On Ne01 etc......I usually just set up an array of Network configurations and loop through to get the correct Ne01 etc with an On Error resume next....your code will take car of this....thanks
 
Upvote 0
On 2002-09-21 12:19, Ivan F Moala wrote:
On Ne01 etc......I usually just set up an array of Network configurations and loop through to get the correct Ne01 etc with an On Error resume next....your code will take car of this....thanks

Ivan, early on I considered that technique, but was worried about the occasional LPT/USB assignments.
 
Upvote 0
On 2002-09-21 12:30, stevebausch wrote:
On 2002-09-21 12:19, Ivan F Moala wrote:
On Ne01 etc......I usually just set up an array of Network configurations and loop through to get the correct Ne01 etc with an On Error resume next....your code will take car of this....thanks

Ivan, early on I considered that technique, but was worried about the occasional LPT/USB assignments.

Yes, you are correct....one way around this is the following...infact it should give you what Juans code gives;

<pre/>
Sub GetPrinters()
Dim WshNetwork
Dim oDrives
Dim oPrinters
Dim i

Set WshNetwork = CreateObject("WScript.Network")
Set oDrives = WshNetwork.EnumNetworkDrives
Set oPrinters = WshNetwork.EnumPrinterConnections
For i = 0 To oPrinters.Count - 1 Step 2
MsgBox oPrinters.Item(i + 1) & " on " & oPrinters.Item(i)
Next
End Sub
</pre>
 
Upvote 0

Forum statistics

Threads
1,213,485
Messages
6,113,931
Members
448,533
Latest member
thietbibeboiwasaco

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top