hi,
You can read the registry lo get a list of all availbable printers and show
them in a list where the user can select the active printer before
printing.(via application.activeprinter= ...)
Regards
Jean-Yves
This function ("ListPrinter") works for NT4 and XP. You can load the
returned array in a listbox or combo.
Else you would have to modify the path to the correct registry folder.
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 Declare Function RegOpenKeyEx Lib "advapi32.dll" 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 RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long)
As Long
Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory"
(Destination As Any, _
Source As Any, ByVal Length As Long)
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const KEY_QUERY_VALUE = &H1
Public Const REG_SZ = 1
Public Const REG_BINARY = 3
Public Const HKEY_CURRENT_USER = &H80000001
Public Function ListPrinter() As Variant
'Portions of this program written by Paul Kuliniewicz"
'
http://www.vbapi.com
' modified by Tfelt Jean-Yves
Dim valuename As String ' name of the value being retrieved
Dim valuelen As Long ' length of valuename
Dim datatype As Long ' receives data type of value
Dim data(0 To 254) As Byte ' 255-byte data buffer for read
information
Dim datalen As Long ' size of data buffer information
Dim datastring As String ' will receive data converted to a
string, if necessary
Dim hKey As Long ' handle to the registry key to
enumerate the values of
Dim index As Long ' counter for the index of the value to
enumerate
Dim c As Long ' counter variable
Dim retval As Long ' functions' return value
Dim strPrinters As String
Dim arrPrinter() As String
Dim i As Byte
i = 0
' Open the registry key to enumerate the values of.
retval = RegOpenKeyEx(HKEY_CURRENT_USER, "Software\Microsoft\Windows
NT\CurrentVersion\Devices", _
0, KEY_QUERY_VALUE, hKey)
' Check to see if an error occured.
If retval <> 0 Then
Debug.Print "Registry key could not be opened -- aborting."
End ' abort the program
End If
' Begin enumerating the values. Get each one, displaying its name.
If it's a null-
' terminated string or binary data, display it. If not, say so.
index = 0 ' initialize the counter
While retval = 0 ' loop while successful
' Initialize the value name buffer.
valuename = Space(255) ' 255-space buffer
valuelen = 255 ' length of the string
datalen = 255 ' size of data buffer
' Get the next value to be enumerated
retval = RegEnumValue(hKey, index, valuename, valuelen, 0,
datatype, data(0), datalen)
If retval = 0 Then ' if successful, display information
' Extract the useful information from the value name
buffer and display it.
valuename = Left(valuename, valuelen)
strPrinters = valuename '"Value Name: ";
' Determine the data type of the value and display
it.
Select Case datatype
Case REG_SZ ' null-terminated string
' Copy the information from the byte array
into the string.
' We subtract one because we don't want the
trailing null.
datastring = Space(datalen - 1) ' make just
enough room in the string
CopyMemory ByVal datastring, data(0),
datalen - 1 ' copy useful data
strPrinters = strPrinters & " on " &
Mid(datastring, 10) ' port name " Data (string): ";
Case REG_BINARY ' binary data
' Display the hexadecimal values of each
byte of data, separated by
' spaces. Use the datastring buffer to
allow us to assure each byte
' is represented by a two-character string.
Debug.Print " Data (binary):";
For c = 0 To datalen - 1 ' loop through
returned information
datastring = Hex(data(c)) ' convert
value into hex
' If needed, add leading zero(s).
If Len(datastring) < 2 Then
datastring = _
String(2 - Len(datastring),
"0") & datastring
Debug.Print " "; datastring;
Next c
Debug.Print ' end the line
Case Else ' a data type this example doesn't handle
Debug.Print "This example doesn't know how
to read that kind of data."
End Select
End If
index = index + 1 ' increment the index counter
ReDim Preserve arrPrinter(i)
arrPrinter(i) = strPrinters
i = i + 1
strPrinters = ""
Wend ' end the loop
' Close the registry key.
retval = RegCloseKey(hKey)
ListPrinter = arrPrinter
End Function
