OBTENIR LA LISTE DES IMPRIMANTES

Voici un exemple de code qui permet de lister les imprimantes présentes sur l'ordinateur et placer leurs noms dans une Combo Box :

Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
' Remarquez les 4 membres déclarés en Long et non en String (contrairement à la doc VB)
' car on veut récupérer des pointeurs
Private Type PRINTER_INFO_1
         flags As Long
         pDescription As Long
         pName As Long
         pComment As Long
End Type

' Remarquez pPrinterEnum déclaré ici en Any et non pas en Byte (contrairement à la doc VB)
' car on récupère d'abord la taille du buffer (Pointeur null), puis une structure PRINTER_INFO_1
Private Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" (ByVal flags As Long, ByVal name As String, ByVal Level As Long, pPrinterEnum As Any, ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
Private Const PRINTER_ENUM_LOCAL = &H2

Private Const NULLPTR = 0&

Dim I As Integer, rc As Long, need As Long
Dim aPi1() As Byte, NbPi1 As Long, PInf1() As PRINTER_INFO_1

' On va énumérer tous les printers installés et on charge leurs noms dans le Combo Box
' On cherche need
NbPi1 = 0
need = 0
rc = EnumPrinters(PRINTER_ENUM_LOCAL, NULLPTR, 1, NULLPTR, need, need, 0)
' ------------------ Si pas d'imprimante ----------------------------------
If need = 0 Then
         MsgBox "Il n'y a pas d'imprimante installée", , "Sélection d'imprimante"
         Exit Sub
End If
' -------------------------------------------------------------------------
         ReDim aPi1(1 To need) As Byte
rc = EnumPrinters(PRINTER_ENUM_LOCAL, NULLPTR, 1, aPi1(1), need, need, NbPi1)
         If rc = 0 Then Exit Sub
         ReDim PInf1(1 To NbPi1) As PRINTER_INFO_1
CopyMemory PInf1(1), aPi1(1), NbPi1 * Len(PInf1(1))
With MyComboBox
         For I = 1 To NbPi1
         .AddItem PtrCtoVbString(PInf1(I).pName)
         Next I
End With

' Procédure pour enlever les caractères nulls
Private Function PtrCtoVbString(Add As Long) As String
Dim sTemp As String * 512, x As Long
x = lstrcpy(sTemp, Add)
If (InStr(1, sTemp, Chr(0)) = 0) Then
         PtrCtoVbString = ""
Else
         PtrCtoVbString = Left(sTemp, InStr(1, sTemp, Chr(0)) - 1)
End If
End Function