VBA-Programmierung in Microsoft Excel

Tutorial: Excel-Beispiele

Installierte Drucker auslesen

Gruppe

API

Bereich

Drucker

Thema

Installierte Drucker auslesen

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

    


Beiträge aus dem Excel-Forum zu den Themen API und Drucker