Excel-Drucker mit Erweiterung (z.B. NE01)

Will man einen anderen Drucker mittels Code einstellen, so hat man das Problem, dass die Drucker von Rechner zu Rechner unterschiedliche Bezeichnungen haben können.
Zum Beispiel "HPDJ690C auf NE01" auf dem einen Rechner und "HPDJ690C auf NE05" auf einem anderen. Mein Code liefert die vollständigen Namen aller Drucker auf einem Rechner. Mit instr auf "HPDJ690C" lässt sich dann der gewünschte Drucker ermitteln. Die OS-Version ist wichtig, da die Infos auf unterschiedlichen Wegen geholt werden müssen. Mein Code funzt unter NT4.0 und WIN 95/98.

Beispieldatei druckerauswahl.zip 18 kB

'Für Win 9x

Private Declare Function lstrcpy Lib "kernel32.dll" Alias _
  "lstrcpyA" (ByVal lpString1 As String, _
  ByVal lpString2 As Long) As Long

Private Declare Function lstrlen Lib "kernel32.dll" Alias _
  "lstrlenA" (ByVal lpString As Long) As Long

Private Declare Function EnumPrinters Lib "winspool.drv" _
  Alias "EnumPrintersA" (ByVal flags As Long, _
  ByVal name As String, ByVal Level As Long, _
  pPrinterEnum As Long, ByVal cdBuf As Long, _
  pcbNeeded As Long, pcReturned As Long) As Long

Private Const PRINTER_ENUM_LOCAL = &H2
'Nur NT und Level1
Private Const PRINTER_ENUM_NETWORK = &H40
'Nur NT
Private Const PRINTER_ENUM_CONNECTIONS = &H4
Private Const PRINTER_ENUM_DEFAULT = &H1
'Nur NT und Level1
Private Const PRINTER_ENUM_REMOTE = &H10
'Nur kombiniert mit anderen Konstanten
Private Const PRINTER_ENUM_SHARED = &H20
'Ab hier für NT

Private 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

Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
  Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal _
  lpValueName As String, ByVal lpReserved As Long, _
  lpType As Long, lpData As Any, lpcbData As Long) As Long

Private 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

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

Private Declare Function GetVersionEx Lib "kernel32" _
  Alias "GetVersionExA" (lpVersionInformation As _
  OSVERSIONINFO) As Integer

Private Type OSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long
  szCSDVersion As String * 128
End Type

Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_QUERY_VALUE = &H1
Private Const READ_CONTROL = &H20000
Private Const KEY_READ = (READ_CONTROL Or KEY_QUERY_VALUE _
  Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY)
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_CURRENT_CONFIG = &H80000005
Private Const HKEY_USERS = &H80000003
Private Const HKEY_PERFORMANCE_DATA = &H80000004
Private Const HKEY_DYN_DATA = &H80000006
Private Const Schlüsselname = _
  "Software\Microsoft\Windows NT\CurrentVersion\Devices\"
  Private Drucker() As String

Public Sub DruckerAnzeigen()
Dim a As Long, b As String
Dim c As Long, Ausgabe As String
Dim OSVersion As OSVERSIONINFO
  With OSVersion
    .dwOSVersionInfoSize = Len(OSVersion)
    .szCSDVersion = Space$(128)
    GetVersionEx OSVersion
    b = Application.ActivePrinter
    If .dwPlatformId = 2 Then
      Druckerliste
    Else
      Druckerliste9x
    End If
  End With
  For a = 1 To UBound(Drucker)
    If Ausgabe <> "" Then Ausgabe = Ausgabe & vbCrLf
    Ausgabe = Ausgabe & Drucker(a)
  Next
  MsgBox Ausgabe
End Sub

' NT

Private Sub Druckerliste()
Dim dummy, hwndSchlüssel&
Dim Länge&, lngIndex&
Dim strFeld As String, lngLänge As Long
Dim arrPuffer() As Byte, strPuffer As String
Dim lngArrLänge As Long, lngPortlänge As Long
  ReDim Drucker(1 To 500)
  dummy = RegOpenKeyEx(HKEY_CURRENT_USER, _
    Schlüsselname, 0&, KEY_READ, hwndSchlüssel)
  If dummy <> 0 Then MsgBox "Falscher Schlüssel": Exit Sub
  strFeld = String(1024, 0)
  lngLänge = 1023
  ReDim arrPuffer(0 To 1000)
  Do While RegEnumValue(hwndSchlüssel, lngIndex, _
    strFeld, lngLänge, 0&, ByVal 0&, ByVal 0&, ByVal 0&) = 0
    Drucker(lngIndex + 1) = Left$(strFeld, lngLänge) & " auf "
    lngArrLänge = 1024
    RegEnumValue hwndSchlüssel, lngIndex, strFeld, _
      lngLänge, 0&, 0&, arrPuffer(0), lngArrLänge
    strPuffer = (StrConv(arrPuffer, vbUnicode))
    lngPortlänge = InStr(1, strPuffer, ":") - _
      InStr(1, strPuffer, ",")
    strPuffer = Mid$(strPuffer, InStr(1, strPuffer, ":") - 4, _
      lngPortlänge)
    Drucker(lngIndex + 1) = Drucker(lngIndex + 1) & strPuffer
    lngIndex = lngIndex + 1
    strFeld = String(1024, 0)
    lngLänge = 1023
  Loop
  ReDim Preserve Drucker(1 To lngIndex + 1)
  dummy = RegCloseKey(hwndSchlüssel)
End Sub

'##########################################
'Nur für Win 9x
'##########################################

Private Sub Druckerliste9x()
Dim arrBuffer() As Long, lngLänge As Long
Dim lngZähler As Long, lngAnzahl As Long
Dim lngRück As Long, lngBuffZähler As Long
Dim PrinterTyp As Long, strDrucker As String
  ReDim arrBuffer(1)
  PrinterTyp = PRINTER_ENUM_CONNECTIONS Or PRINTER_ENUM_LOCAL _
    Or PRINTER_ENUM_NETWORK
  'Buffergröße ermitteln
  lngRück = EnumPrinters(PrinterTyp, _
    vbNullString, 2, arrBuffer(0), 0&, _
    lngLänge, lngAnzahl)
  'Buffer bereitstellen
  ReDim arrBuffer(0 To (lngLänge + 3) \ 4)
  'Infos über Drucker holen
  lngRück = EnumPrinters(PrinterTyp, vbNullString, _
    2, arrBuffer(0), lngLänge, lngLänge, lngAnzahl)
  If lngAnzahl = 0 Then MsgBox "Keine Drucker verfügbar": Exit Sub
  ReDim Drucker(1 To lngAnzahl)
  For lngZähler = 1 To lngAnzahl
    lngBuffZähler = lngBuffZähler + 1
    strDrucker = StringVonPointer(arrBuffer(lngBuffZähler))
    lngBuffZähler = lngBuffZähler + 2
    strDrucker = strDrucker & " auf "
    strDrucker = strDrucker & _
      StringVonPointer(arrBuffer(lngBuffZähler))
    Drucker(lngZähler) = strDrucker
    lngBuffZähler = lngBuffZähler + 18
  Next
End Sub

Private Function StringVonPointer(plngAscii As Long) As String
Dim lngAnzahl&, strName$
  lngAnzahl = lstrlen(plngAscii)
  strName = String(lngAnzahl, 0)
  lstrcpy strName, plngAscii
  If InStr(1, strName, Chr(0)) <> 0 Then
    strName = Left$(strName, InStr(1, strName, Chr(0)) - 1)
  End If
  StringVonPointer = strName
End Function