Listing Printers In VBA
This page describes how to list available printers in VBA.
You can use VBA to create a list of printers connected to the PC. You can use this
list to allow the user to select a printer from your application. The code on this
page gets its list of printers from the system registry, specifically the key
HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Devices
The code here is a function named GetPrinterFullNames that
reads the registry and returns a String() array, where each
element in the array is the name of a printer device connected to the PC. You can then loop through
the list with code like:
Sub AAA()
Dim Printers() As String
Dim N As Long
Dim S As String
Printers = GetPrinterFullNames()
For N = LBound(Printers) To UBound(Printers)
S = S & Printers(N) & vbNewLine
Next N
MsgBox S, vbOKOnly, "Printers"
End Sub
You can change the ActivePrinter property of the Application
object to set a new default printer. For example,
Application.ActivePrinter = Printers(3)
Note that changing the ActivePrinter in VBA sets the active printer for Excel. It does not change the default printer in Windows.
The full code is shown below:
Option Explicit
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 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
Private 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
Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
ByVal HKey As Long) As Long
Public Function GetPrinterFullNames() As String()
Dim Printers() As String
Dim PNdx As Long
Dim HKey As Long
Dim Res As Long
Dim Ndx As Long
Dim ValueName As String
Dim ValueNameLen As Long
Dim DataType As Long
Dim ValueValue() As Byte
Dim ValueValueS As String
Dim CommaPos As Long
Dim ColonPos As Long
Dim M As Long
Const PRINTER_KEY = "Software\Microsoft\Windows NT\CurrentVersion\Devices"
PNdx = 0
Ndx = 0
ValueName = String$(256, Chr(0))
ValueNameLen = 255
ReDim ValueValue(0 To 999)
ReDim Printers(1 To 1000)
Res = RegOpenKeyEx(HKCU, PRINTER_KEY, 0&, _
KEY_QUERY_VALUE, HKey)
Res = RegEnumValue(HKey, Ndx, ValueName, _
ValueNameLen, 0&, DataType, ValueValue(0), 1000)
Do Until Res = ERROR_NO_MORE_ITEMS
M = InStr(1, ValueName, Chr(0))
If M > 1 Then
ValueName = Left(ValueName, M - 1)
End If
CommaPos = InStr(1, ValueValue, ",")
ColonPos = InStr(1, ValueValue, ":")
On Error Resume Next
ValueValueS = Mid(ValueValue, CommaPos + 1, ColonPos - CommaPos)
On Error GoTo 0
PNdx = PNdx + 1
Printers(PNdx) = ValueName & " on " & ValueValueS
ValueName = String(255, Chr(0))
ValueNameLen = 255
ReDim ValueValue(0 To 999)
ValueValueS = vbNullString
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
ReDim Preserve Printers(1 To PNdx)
Res = RegCloseKey(HKey)
GetPrinterFullNames = Printers
End Function
|
This page last updated: 21-Sept-2012. |