Zum Inhalt springen

Drucker in Excel via VBA auslesen


Landaley

Empfohlene Beiträge

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

Link zu diesem Kommentar
Auf anderen Seiten teilen

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.

Link zu diesem Kommentar
Auf anderen Seiten teilen

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

Link zu diesem Kommentar
Auf anderen Seiten teilen

Dein Kommentar

Du kannst jetzt schreiben und Dich später registrieren. Wenn Du ein Konto hast, melde Dich jetzt an, um unter Deinem Benutzernamen zu schreiben.

Gast
Auf dieses Thema antworten...

×   Du hast formatierten Text eingefügt.   Formatierung wiederherstellen

  Nur 75 Emojis sind erlaubt.

×   Dein Link wurde automatisch eingebettet.   Einbetten rückgängig machen und als Link darstellen

×   Dein vorheriger Inhalt wurde wiederhergestellt.   Editor leeren

×   Du kannst Bilder nicht direkt einfügen. Lade Bilder hoch oder lade sie von einer URL.

Fachinformatiker.de, 2024 by SE Internet Services

fidelogo_small.png

Schicke uns eine Nachricht!

Fachinformatiker.de ist die größte IT-Community
rund um Ausbildung, Job, Weiterbildung für IT-Fachkräfte.

Fachinformatiker.de App

Download on the App Store
Get it on Google Play

Kontakt

Hier werben?
Oder sende eine E-Mail an

Social media u. feeds

Jobboard für Fachinformatiker und IT-Fachkräfte

×
×
  • Neu erstellen...