Dynamically assign Adobe printer in Excel micro 1

[MockY]

When I want print to a specific printer from a Vba Excel macro, it typically wants the printer to be named and to reference the port.

Here is an example of what I have been using for the printer name:

Application.ActivePrinter = "Adobe PDF on Ne02:"

The problem is that sometimes the Ne02 changes depending upon the user or if the server is modified.

Is there anyway to reference an alias to this printer, or get to the printer using a name that would not change per user and during the year?

 

[Chance1234]

Take a look at

http://word.mvps.org/FAQs/MacrosVBA/AvailablePrinters.htm

from there you should be able to construct a routine that checks whta printers are availiable and if its the printer you want

Chance,

F, G + Its official, its even on a organisation chart et all

 

[MockY]

That link was to great help, Thanks.

 

[tbl]

This is what I use to not only detect ALL available printers but also to add their Network Ports. Whereas Word will print to a printer name, Excel for some curious reason will not, it requires the full path, eg. \\X06 on Ne:02

Option Explicit

Const PRINTER_ENUM_CONNECTIONS = &H4
Const PRINTER_ENUM_LOCAL = &H2

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

Public 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

'EnumPrinters will return a value False if the buffer is not big enough
bSuccess = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
PRINTER_ENUM_LOCAL, vbNullString, _
1, iBuffer(0), iBufferSize, iBufferRequired, iEntries)

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

If Not bSuccess Then
'Enumprinters returned False
MsgBox "Error enumerating printers."
Exit Function
Else
'Enumprinters returned True, use found printers to fill the array
ReDim StrPrinters(iEntries - 1)
For iIndex = 0 To iEntries - 1
'Get the printername
strPrinterName = Space$(StrLen(iBuffer(iIndex * 4 + 2)))
iDummy = PtrToStr(strPrinterName, iBuffer(iIndex * 4 + 2))
StrPrinters(iIndex) = strPrinterName
Range("PrinterListRef").Offset(iIndex + 2, 0) = strPrinterName
Next iIndex
End If

ListPrinters = StrPrinters
ActiveWorkbook.Names.Add name:="PrinterList", RefersToR1C1:="=Config!R16C6:R" & 19 + iEntries & "C6"
End Function
Sub GetAvailablePrinters() 'MAIN ROUTINE _GETS LIST OF ALL PRINTERS WITH NE: PORTS
Dim StrPrinters As Variant, x As Long

Range("PrinterListRange").ClearContents
Range("DefaultPrinter").Offset(0, 1) = Application.ActivePrinter

StrPrinters = ListPrinters

'Fist check whether the array is filled with anything, by calling another function, IsBounded.
If IsBounded(StrPrinters) Then
For x = LBound(StrPrinters) To UBound(StrPrinters)
'Debug.Print StrPrinters(x)
'Range("PrinterRef").Offset(x + 2, 1) = StrPrinters(x)
Range("DefaultPrinter").Offset(x + 2, 0) = GetFullNetworkPrinterName(CStr(StrPrinters(x)))
Next x
Else
Debug.Print "No printers found"
End If

End Sub

Public Function IsBounded(vArray As Variant) As Boolean

'If the variant passed to this function is an array, the function will return True;
'otherwise it will return False
On Error Resume Next
IsBounded = IsNumeric(UBound(vArray))

End Function

'Change the default printer
'This example macro shows how to print a selected document to another
'printer then the default printer. This is done by changing the property Application.ActivePrinter:

Sub PrintToAnotherPrinter()
Dim strCurrentPrinter As String
strCurrentPrinter = Application.ActivePrinter ' store the current active printer
On Error Resume Next ' ignore printing errors
Application.ActivePrinter = "microsoft fax on fax:" ' change to another printer
ActiveSheet.PrintOut ' print the active sheet
Application.ActivePrinter = strCurrentPrinter ' change back to the original printer
On Error GoTo 0 ' resume normal error handling
End Sub
'Print to a network printer
'The example macros below shows how to get the full network printer name
'(useful when the network printer name can change) and print a worksheet to this printer:

Sub PrintToNetworkPrinterExample()
Dim strCurrentPrinter As String, strNetworkPrinter As String
strNetworkPrinter = GetFullNetworkPrinterName("HP LaserJet 8100 Series PCL")
If Len(strNetworkPrinter) > 0 Then ' found the network printer
strCurrentPrinter = Application.ActivePrinter
' change to the network printer
Application.ActivePrinter = strNetworkPrinter
Worksheets(1).PrintOut ' print something
' change back to the previously active printer
Application.ActivePrinter = strCurrentPrinter
End If
End Sub

Function GetFullNetworkPrinterName(strNetworkPrinterName As String) As String
' returns the full network printer name
' returns an empty string if the printer is not found
' e.g. GetFullNetworkPrinterName("HP LaserJet 8100 Series PCL")
' might return "HP LaserJet 8100 Series PCL on Ne04:"
Dim strCurrentPrinterName As String, strTempPrinterName As String, i As Long
strCurrentPrinterName = Application.ActivePrinter
i = 0
Do While i < 100
strTempPrinterName = strNetworkPrinterName & " on Ne" & Format(i, "00") & ":"
On Error Resume Next ' try to change to the network printer
Application.ActivePrinter = strTempPrinterName
On Error GoTo 0
If Application.ActivePrinter = strTempPrinterName Then
' the network printer was found
GetFullNetworkPrinterName = strTempPrinterName

i = 100 ' makes the loop end
End If
i = i + 1
Loop
' remove the line below if you want the function to change the active printer
'Application.ActivePrinter = strCurrentPrinterName ' change back to the original printer
End Function

Sub ChangePrinter()
Dim ChangeToPrinter As String
ChangeToPrinter = "Jaws PDF Creator"
MsgBox (GetFullNetworkPrinterName(ChangeToPrinter))

End Sub

 

[csfan]

This is exactly the same problem I'm having using the same call for printers as "tbl".

I believe that the root of the problem is over time something changes the NE02 to NE01 or NE03 and this stops any code calling the printer by name in Excel. The call for printers we are using doesn't include the "NE0_" in the name.

 

[tbl]

If you look at my code you will see that it does detect the true network port for each printer. I have been using this for years to detect each printer and then test for the correct network port.

 

[tbl]

Just as a matter of interest, the Network Port is something that is created by the Windows operating system. On a PC where many printers have been installed, even if they have been subsequently deleted, the Network Port numbers will be higher than on a PC which has only one network printer. Each time a printer is added, Windows automatically creates a new port with the next unused number.
For this reason, if you are writing an application that must run on any PC and also print to the same printer, you must detect not only the printer but the port.

 

[MockY]

Works wonderfully for me.

 

[csfan]

ME TOO!!! I had a little goof in mine. Thanks all.