Halli, Hallo.

Ich möchte in Excel 2002 über VBA sämtliche Drucker inkl. Netzwerkdrucker auslesen. Das ganze versuche ich über die Registry und habe folgenden Code:

Option Explicit

Option Base 0


Const MAX_PRINTERS = 16


Declare Function GetProfileString Lib "kernel32" _

Alias "GetProfileStringA" _

(ByVal lpAppName As String, _

ByVal lpKeyName As String, _

ByVal lpDefault As String, _

ByVal lpReturnedString As String, _

ByVal nSize As Long) As Long


Dim strPrinterNames(MAX_PRINTERS) As String

Dim strPrinterDrivers(MAX_PRINTERS) As String

Dim strPrinterPorts(MAX_PRINTERS) As String

Dim intPrinterCount As Integer


Sub GetPrinterList()


Dim r As Long

Dim Buffer As String

Dim i As Integer


' Liste aller Drucker aus der Registry auslesen

Buffer = Space(8192)

r = GetProfileString("PrinterPorts", vbNullString, "", _

Buffer, Len(Buffer))


' Druckernamen und -ports parsen

GetPrinterNames Buffer

GetPrinterPorts


For i = 1 To intPrinterCount

Debug.Print strPrinterNames(i), strPrinterPorts(i), strPrinterDrivers(i)

Next i


End Sub


Private Sub GetPrinterNames(ByVal Buffer As String)


Dim i As Integer

Dim strName As String


intPrinterCount = 0


Do

i = InStr(Buffer, Chr(0))

If i > 0 Then

strName = Left(Buffer, i - 1)

If Len(Trim(strName)) > 0 Then

strPrinterNames(intPrinterCount) = Trim(strName)

intPrinterCount = intPrinterCount + 1

End If

Buffer = Mid(Buffer, i + 1)

Else

If Len(Trim(Buffer)) > 0 Then

strPrinterNames(intPrinterCount) = Trim(Buffer)

intPrinterCount = intPrinterCount + 1

End If

Buffer = ""

End If

Loop While (i > 0) And (intPrinterCount < MAX_PRINTERS)


End Sub


Private Sub GetPrinterPorts()


Dim Buffer As String

Dim i As Integer

Dim r As Long


For i = 0 To intPrinterCount - 1


Buffer = Space(1024)

r = GetProfileString("PrinterPorts", strPrinterNames(i), "", _

Buffer, Len(Buffer))


GetDriverAndPort Buffer, strPrinterDrivers(i), strPrinterPorts(i)


Next i

End Sub


Private Sub GetDriverAndPort(ByVal Buffer As String, DriverName As _

String, PrinterPort As String)


Dim iDriver As Integer

Dim iPort As Integer


DriverName = ""

PrinterPort = ""


iDriver = InStr(Buffer, ",")

If iDriver > 0 Then


DriverName = Left(Buffer, iDriver - 1)


iPort = InStr(iDriver + 1, Buffer, ",")


If iPort > 0 Then

PrinterPort = Mid(Buffer, iDriver + 1, _

iPort - iDriver - 1)

End If

End If


End Sub

Interessanterweise macht dieser Code... gar nichts.

Hat hier vielleicht irgendjemand 'ne Ahnung oder bessere Lösung für dieses Problem? Oder zumindest nen Denkanstoss?

Danke schon mal im Vorraus.

Gruß,

Landaley

Ok, passt, hab's selbst herausgefunden. Erst überlegen, dann fragen, naja... .

Trotzdem danke.

also ich weiss ja nicht, woher du das beispiel hast ... aber die API-funktion GetProfileString liest nicht aus der registry, sondern aus INI-dateien.

das wird also nicht funktionieren.

edit: aha, und wie? würde mich interessieren

s'Amstel

Jo, das Beispiel war Humbug mit Apfelsoße.

Bis jetzt hab ichs so gelöst:

Private Sub CommandButton2_Click()


Dim objWMI As Object, colPrinters As Object, objPrinter As Object

Set objWMI = GetObject("winmgmts:" _

    & "{impersonationLevel=impersonate}!\\" & "." & "\root\cimv2")

Set colPrinters = objWMI.ExecQuery _

   ("Select * from Win32_PrinterConfiguration")

For Each objPrinter In colPrinters

   MsgBox "Name: " & objPrinter.Name

Next


End Sub

Wobei das ja auch nicht das gelbe vom Ei ist, jetzt zeigt er mir zwar die Drucker in 'ner MessageBox an, aber den aktiven Drucker wechseln kann ich immer noch nicht, da ich ja nicht mal weiß, auf welchem Anschluss die liegen.

Das ganze sollte halt so aussehen:

"Lexmark Optra Blabla auf LPT 1"

tuts aber nicht.

wenn du den anschluss/die anschlüsse wissen willst, an denen der drucker hängt, hilft dir vielleicht Win32_Printer

und dort:

PortName

Data type: string

Access type: Read/write

Port that is used to transmit data to a printer. If a printer is connected to more than one port, the names of each port are separated by commas. Under Windows 95, only one port can be specified.

Example: LPT1:, LPT2:, LPT3:

s'Amstel

Äh, ja, danke für den Tipp, hab ich ganz vergessen .