Hier eine komplette Lösung (bislang nur unter Excel 2003 getestet)

Const PRINTER_ENUM_CONNECTIONS = &H4
Const PRINTER_ENUM_LOCAL = &H2
Declare Function EnumPrinters Lib "winspool.drv" Alias _
"EnumPrintersA" (ByVal flags As Long, _
ByVal xName As String, ByVal Level As Long, _
pPrinterEnum As Long, ByVal cdBuf As Long, _
pcbNeeded As Long, pcReturned As Long) As Long

Declare Function PtrToStr Lib "Kernel32" Alias "lstrcpyA" _
(ByVal RetVal As String, ByVal Ptr As Long) As Long

Declare Function StrLen Lib "Kernel32" Alias "lstrlenA" _
(ByVal Ptr As Long) As Long

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) = LangerDruckerName(aPrinter)
   Next aPrinter
End Sub

Function GetPrnName(Template As String) As String
Dim cbRequired As Long, cbBuffer As Long
Dim Buffer() As Long, nEntries As Long
Dim I As Long, PDesc As String, Try2 As Boolean
cbBuffer = 3000
TryAgain:
ReDim Buffer((cbBuffer \ 4) - 1)
If EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
PRINTER_ENUM_LOCAL, "", 1, Buffer(0), cbBuffer, _
cbRequired, nEntries) Then
For I = 0 To nEntries - 1
PDesc = Space$(StrLen(Buffer(I * 4 + 2)))
PtrToStr PDesc, Buffer(I * 4 + 2)
If LCase(PDesc) Like LCase(Template) Then
GetPrnName = PDesc
Exit For
End If
Next
Else
If Not Try2 Then
Try2 = True
cbBuffer = cbRequired
GoTo TryAgain
End If
End If
End Function

Function LangerDruckerName(ByVal DruckerName As String) As String
   Dim intI As Integer
   
   On Error Resume Next
   For intI = 0 To 20
      Err.Clear
      Application.ActivePrinter = DruckerName & " auf Ne" & Format(intI, "00") & ":"
      If Err = 0 Then
         LangerDruckerName = Application.ActivePrinter
         Exit For
      End If
   Next
   On Error GoTo 0
End Function

Sub drucken_auf()

' hier einen der gelisteten Drucker auswählen
Dim p As String
sName = Application.ActivePrinter

p = Cells(3, 1).Value
'Stop
  Application.ActivePrinter = p
End Sub

Viel Spaß