How can I get a list of the available printer names

K

Ken

The code found in the this article works in Excel as well.
http://word.mvps.org/FAQs/MacrosVBA/AvailablePrinters.htm

Here is a list of printers the code generated on my PC:

Quicken PDF Printer
Microsoft XPS Document Writer
Microsoft Office Document Image Writer
HP Photosmart 2600 series
Generic / Text Only
DYMO LabelWriter 330 Turbo
DELL3110cn-417FC9-PS
DELL3110cn-417FC9
Dell Laser Printer 1700n PS3
Adobe PDF

The issue I'm having is that the name listed is not the name needed in order
to reference one of the printers. This is because windows always adds "on
NeXX", where XX is a number such as 04, to the end of every printer name.
Therefore, "Adobe PDF" is really "Adobe PDF on Ne04" for instance. This is
true for all printers and I've tried it on multiple PCs.

If someone could modify this code or supply provide different code that
returns the actual full printer names it would be very helpful.
Additionally, if you would provide a way to always select/reference the
desired printer based on the short name. For instance, return the full name
of the printer name that starts with "Adobe PDF".

Thanks,

Ken
 
O

OssieMac

Hello,

This might not be the answer you are looking for but I am wondering if the
reason for wanting the list of available printers is so that the user can
select the required printer. If so, then the following displays the printer
selection and setup dialog box.

Application.Dialogs(xlDialogPrinterSetup).Show
 
K

Ken

Thank you OssieMac and JLGWhiz for your suggestions.

I didn't want the user to have to do anything other then click a macro
button to print. The code would find a printer with a FULL name starting
with "Adobe PDF", which the full name is "Adobe PDF on Ne07:", and set it as
the ActivePrinter. So kind of like a wild card.

I just found the perfect code at the following link and it works perfectly.
I highly recommend it!!!
http://www.erlandsendata.no/english/index.php?d=envbaprintchangeprinter

Ken
 
C

Chip Pearson

The following code contains a function named GetPrinterFullNames that
enumerates through the registry and returns an array of Strings, each
of which names one printer by name followed by port number. E.g.,
"HP Photosmart C8100 on Ne06:". These strings are suitable for
assignment to the ActivePrinter property.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Registry API declares and consts.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKCU = HKEY_CURRENT_USER
Private Const KEY_QUERY_VALUE = &H1&
Private Const ERROR_NO_MORE_ITEMS = 259&
Private Const ERROR_MORE_DATA = 234

Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
ByVal HKey As Long) As Long

Private Declare Function RegOpenKeyEx Lib "advapi32" _
Alias "RegOpenKeyExA" ( _
ByVal HKey As Long, _
ByVal lpSubKey As String, _
ByVal ulOptions As Long, _
ByVal samDesired As Long, _
phkResult As Long) As Long

Public Declare Function RegEnumValue Lib "advapi32.dll" _
Alias "RegEnumValueA" ( _
ByVal HKey As Long, _
ByVal dwIndex As Long, _
ByVal lpValueName As String, _
lpcbValueName As Long, _
ByVal lpReserved As Long, _
lpType As Long, _
lpData As Byte, _
lpcbData As Long) As Long


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function GetPrinterFullNames() As String()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' GetPrinterFullNames
' By Chip Pearson, (e-mail address removed), www.cpearson.com
' Returns an array of printer names, where each printer name
' is the device name followed by the port name. The value can
' be used to assign a printer to the ActivePrinter property.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Printers() As String ' array of names to be returned
Dim PNdx As Long ' index into Printers()
Dim HKey As Long ' registry key handle
Dim Res As Long ' result of API calls
Dim Ndx As Long ' index for RegEnumValue
Dim ValueName As String ' name of each value in the printer key
Dim ValueNameLen As Long ' length of ValueName
Dim DataType As Long ' registry value data type
Dim ValueValue() As Byte ' byte array of registry value value
Dim ValueValueS As String ' ValueValue converted to String
Dim CommaPos As Long ' position of comma char in ValueValue
Dim ColonPos As Long ' position of colon char in ValueValue
Dim M As Long ' string index

' registry key in HCKU listing printers
Const PRINTER_KEY = "Software\Microsoft\" & _
"Windows NT\CurrentVersion\Devices"

PNdx = 0
Ndx = 0
' assume printer name is less than 256 characters
ValueName = String$(256, Chr(0))
ValueNameLen = 255
' assume the port name is less than 100 characters
ReDim ValueValue(0 To 99)
' assume there are less than 1000 printers installed
ReDim Printers(1 To 1000)

' open the key whose values enumerate installed printers
Res = RegOpenKeyEx(HKCU, PRINTER_KEY, 0&, _
KEY_QUERY_VALUE, HKey)
' start enumeration loop of printers
Res = RegEnumValue(HKey, Ndx, ValueName, _
ValueNameLen, 0&, DataType, ValueValue(0), 1000)
' loop until all values have been enumerated
Do Until Res = ERROR_NO_MORE_ITEMS
M = InStr(1, ValueName, Chr(0))
If M > 1 Then
' clean up the ValueName
ValueName = Left(ValueName, M - 1)
End If
' find position of a comma and colon in the port name
CommaPos = InStr(1, ValueValue, ",")
ColonPos = InStr(1, ValueValue, ":")
' ValueValue byte array to ValueValueS string
ValueValueS = Mid(ValueValue, CommaPos + 1, ColonPos - CommaPos)
' next slot in Printers
PNdx = PNdx + 1
Printers(PNdx) = ValueName & " on " & ValueValueS
' reset some variables
ValueName = String(255, Chr(0))
ValueNameLen = 255
ReDim ValueValue(0 To 999)
ValueValueS = vbNullString
' tell RegEnumValue to get the next registry value
Ndx = Ndx + 1
' get the next printer
Res = RegEnumValue(HKey, Ndx, ValueName, ValueNameLen, _
0&, DataType, ValueValue(0), 1000)
If (Res <> 0) And (Res <> ERROR_MORE_DATA) Then
Exit Do
End If
Loop
' shrink Printers down to used size
ReDim Preserve Printers(1 To PNdx)
Res = RegCloseKey(HKey)
GetPrinterFullNames = Printers
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

You can then call this code with something like:


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Test()
Dim Printers() As String
Dim N As Long
Printers = GetPrinterFullNames()
For N = LBound(Printers) To UBound(Printers)
Debug.Print Printers(N)
Next N
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)
 
K

Ken

Thank you Chip.

Chip Pearson said:
The following code contains a function named GetPrinterFullNames that
enumerates through the registry and returns an array of Strings, each
of which names one printer by name followed by port number. E.g.,
"HP Photosmart C8100 on Ne06:". These strings are suitable for
assignment to the ActivePrinter property.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Registry API declares and consts.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKCU = HKEY_CURRENT_USER
Private Const KEY_QUERY_VALUE = &H1&
Private Const ERROR_NO_MORE_ITEMS = 259&
Private Const ERROR_MORE_DATA = 234

Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
ByVal HKey As Long) As Long

Private Declare Function RegOpenKeyEx Lib "advapi32" _
Alias "RegOpenKeyExA" ( _
ByVal HKey As Long, _
ByVal lpSubKey As String, _
ByVal ulOptions As Long, _
ByVal samDesired As Long, _
phkResult As Long) As Long

Public Declare Function RegEnumValue Lib "advapi32.dll" _
Alias "RegEnumValueA" ( _
ByVal HKey As Long, _
ByVal dwIndex As Long, _
ByVal lpValueName As String, _
lpcbValueName As Long, _
ByVal lpReserved As Long, _
lpType As Long, _
lpData As Byte, _
lpcbData As Long) As Long


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function GetPrinterFullNames() As String()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' GetPrinterFullNames
' By Chip Pearson, (e-mail address removed), www.cpearson.com
' Returns an array of printer names, where each printer name
' is the device name followed by the port name. The value can
' be used to assign a printer to the ActivePrinter property.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Printers() As String ' array of names to be returned
Dim PNdx As Long ' index into Printers()
Dim HKey As Long ' registry key handle
Dim Res As Long ' result of API calls
Dim Ndx As Long ' index for RegEnumValue
Dim ValueName As String ' name of each value in the printer key
Dim ValueNameLen As Long ' length of ValueName
Dim DataType As Long ' registry value data type
Dim ValueValue() As Byte ' byte array of registry value value
Dim ValueValueS As String ' ValueValue converted to String
Dim CommaPos As Long ' position of comma char in ValueValue
Dim ColonPos As Long ' position of colon char in ValueValue
Dim M As Long ' string index

' registry key in HCKU listing printers
Const PRINTER_KEY = "Software\Microsoft\" & _
"Windows NT\CurrentVersion\Devices"

PNdx = 0
Ndx = 0
' assume printer name is less than 256 characters
ValueName = String$(256, Chr(0))
ValueNameLen = 255
' assume the port name is less than 100 characters
ReDim ValueValue(0 To 99)
' assume there are less than 1000 printers installed
ReDim Printers(1 To 1000)

' open the key whose values enumerate installed printers
Res = RegOpenKeyEx(HKCU, PRINTER_KEY, 0&, _
KEY_QUERY_VALUE, HKey)
' start enumeration loop of printers
Res = RegEnumValue(HKey, Ndx, ValueName, _
ValueNameLen, 0&, DataType, ValueValue(0), 1000)
' loop until all values have been enumerated
Do Until Res = ERROR_NO_MORE_ITEMS
M = InStr(1, ValueName, Chr(0))
If M > 1 Then
' clean up the ValueName
ValueName = Left(ValueName, M - 1)
End If
' find position of a comma and colon in the port name
CommaPos = InStr(1, ValueValue, ",")
ColonPos = InStr(1, ValueValue, ":")
' ValueValue byte array to ValueValueS string
ValueValueS = Mid(ValueValue, CommaPos + 1, ColonPos - CommaPos)
' next slot in Printers
PNdx = PNdx + 1
Printers(PNdx) = ValueName & " on " & ValueValueS
' reset some variables
ValueName = String(255, Chr(0))
ValueNameLen = 255
ReDim ValueValue(0 To 999)
ValueValueS = vbNullString
' tell RegEnumValue to get the next registry value
Ndx = Ndx + 1
' get the next printer
Res = RegEnumValue(HKey, Ndx, ValueName, ValueNameLen, _
0&, DataType, ValueValue(0), 1000)
If (Res <> 0) And (Res <> ERROR_MORE_DATA) Then
Exit Do
End If
Loop
' shrink Printers down to used size
ReDim Preserve Printers(1 To PNdx)
Res = RegCloseKey(HKey)
GetPrinterFullNames = Printers
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

You can then call this code with something like:


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Test()
Dim Printers() As String
Dim N As Long
Printers = GetPrinterFullNames()
For N = LBound(Printers) To UBound(Printers)
Debug.Print Printers(N)
Next N
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top