Option Explicit
Private Declare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As LongPtr) As Long
Private Declare PtrSafe Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As LongPtr, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As LongPtr, lpType As Long, lpData As Byte, lpcbData As Long) As Long
Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As LongPtr) As Long
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKCU = HKEY_CURRENT_USER
Private Const PRINTER_KEY = "Software\Microsoft\Windows NT\CurrentVersion\Devices"
Private Const KEY_QUERY_VALUE = &H1&
Private Const ERROR_NO_MORE_ITEMS = &H103
Private Const ERROR_MORE_DATA = &HEA
Public Function GetPrintersListV2(Optional IndexKey As Long = 0) As Variant
Dim hKey As LongPtr, Res&, PrinterName$, DataType&, ValueValue() As Byte, i&, tx$, t$, a&, b&
Static printers$(): Static indx As Long
PrinterName = String$(256, Chr(0)): ReDim ValueValue(0 To 999): If IndexKey = 0 Then ReDim printers(1 To 1): indx = 0
RegOpenKeyEx HKCU, PRINTER_KEY, 0&, KEY_QUERY_VALUE, hKey
RegEnumValue hKey, IndexKey, PrinterName, Len(PrinterName), 0&, DataType, ValueValue(0), 1000: RegCloseKey hKey
PrinterName = Split(PrinterName, Chr(0))(0)
If Trim(PrinterName) <> "" Then
t = StrConv(ValueValue, vbUnicode): a = InStr(1, t, ","): b = InStr(1, t, ":")
tx = "": For i = a + 1 To b: tx = tx & Mid(t, i, 1): Next:
indx = indx + 1: ReDim Preserve printers(1 To indx): printers(indx) = PrinterName & " sur " & tx
Debug.Print PrinterName & " sur " & tx
GetPrintersListV2 IndexKey + 1
End If
If IndexKey = 20 Then Exit Function
GetPrintersListV2 = printers:
End Function
Sub test3()
Dim t, i&
t = GetPrintersListV2
For i = LBound(t) To UBound(t)
If Not t(i) Like "*nul*" Then Application.ActivePrinter = t(i)
MsgBox Application.ActivePrinter
Next i
End Sub
Sub TestImprimanteChoisie()
ImprimanteChoisie ("HP8B643A")
Debug.Print Application.ActivePrinter
ImprimanteChoisie ("Microsoft Print to PDF")
Debug.Print Application.ActivePrinter
End Sub
Sub ImprimanteChoisie(ByVal NomImprimante As String)
Dim t, i&
t = GetPrintersList
For i = LBound(t) To UBound(t)
If Not t(i) Like "*Nul*" And InStr(1, t(i), NomImprimante, vbTextCompare) > 0 Then
Application.ActivePrinter = t(i)
Exit For
End If
Next i
End Sub
