AW: VBA zum Drucker ansteuern
21.03.2011 17:08:27
Ralf_P
Hallo Claudia,
folgender Code listet die Angaben im Direktfenster (hilft Dir das?):
' ---------------------------------------------------------------------------
'
' Module: PrinterSettings
'
' Author: Andreas Mütze
'
' Description: Printer Settings
'
' ---------------------------------------------------------------------------
Option Explicit
Option Base 0
' API-Funktionen zur Windows-Druckersteuerung
' Win32-SDK
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
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
VG, Ralf