Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Installierte Drucker auslesen

Gruppe

Drucker

Problem

Die installierten Drucker sollen ausgelesen werden.

Lösung
Den nachstehenden Code in ein Standardmodul eingeben, einer Schaltfläche zuweisen und starten.

ClassModule: DieseArbeitsmappe

StandardModule: Modul1

Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

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

Declare Function RegEnumKeyEx _
   Lib "advapi32.dll" _
   Alias "RegEnumKeyExA" _
   ( _
   ByVal hKey As Long, _
   ByVal dwIndex As Long, _
   ByVal lpName As String, _
   lpcbName As Long, ByVal _
   lpReserved As Long, _
   ByVal lpClass As String, _
   lpcbClass As Long, _
   lpftLastWriteTime As FILETIME _
   ) _
   As Long

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

Public Function fncEnumInstalledPrintersReg() As Collection
   Dim tmpFunctionResult As Boolean
   Dim aFileTimeStruc As FILETIME
   Dim AddressofOpenKey As Long, aPrinterName As String
   Dim aPrinterIndex As Integer, aPrinterNameLen As Long
   Const KEY_ENUMERATE_SUB_KEYS = &H8
   Const HKEY_LOCAL_MACHINE = &H80000002
   Set fncEnumInstalledPrintersReg = New Collection
   aPrinterIndex = 0
   tmpFunctionResult = Not CBool _
      ( _
      RegOpenKeyEx _
      ( _
      hKey:=HKEY_LOCAL_MACHINE, _
      lpSubKey:="SYSTEM\CURRENTCONTROLSET\CONTROL\PRINT\PRINTERS", _
      ulOptions:=0, _
      samDesired:=KEY_ENUMERATE_SUB_KEYS, _
      phkResult:=AddressofOpenKey _
      ) _
      )
   If tmpFunctionResult = False Then GoTo ExitFunction
   Do
      aPrinterNameLen = 255
      aPrinterName = String(aPrinterNameLen, CStr(0))
      tmpFunctionResult = Not CBool _
         ( _
         RegEnumKeyEx _
         ( _
         hKey:=AddressofOpenKey, _
         dwIndex:=aPrinterIndex, _
         lpName:=aPrinterName, _
         lpcbName:=aPrinterNameLen, _
         lpReserved:=0, _
         lpClass:=vbNullString, _
         lpcbClass:=0, _
         lpftLastWriteTime:=aFileTimeStruc _
         ) _
         )
      aPrinterIndex = aPrinterIndex + 1
      If tmpFunctionResult = False Then Exit Do
      aPrinterName = Left(aPrinterName, aPrinterNameLen)
      On Error Resume Next
      fncEnumInstalledPrintersReg.Add aPrinterName
      On Error GoTo 0
   Loop
   Call RegCloseKey(AddressofOpenKey)
   '
   Exit Function
ExitFunction:
   If Not AddressofOpenKey = 0 Then _
      Call RegCloseKey(AddressofOpenKey)
   Set fncEnumInstalledPrintersReg = Nothing
End Function

Sub DruckerAuslesen()
   Dim aPrinter As Variant
   Dim iRow As Integer
   For Each aPrinter In fncEnumInstalledPrintersReg
      iRow = iRow + 1
      Cells(iRow, 1) = aPrinter
   Next aPrinter
End Sub