AW: Drucker wechseln
23.10.2007 12:16:00
IngGi
Hallo M Merlin,
folgenden Code habe ich mir mal aus dem Internet - ich glaube sogar aus diesem Forum hier - kopiert. Damit lassen sich alle Druckeranschlüsse auf einem PC auslesen und in ein Tabellenblatt ausgeben:
Option Explicit
Declare Function GetProfileString Lib "kernel32" Alias _
"GetProfileStringA" (ByVal lpApplicationName As String, _
ByVal lpKeyName As String, ByVal lpDefault As String, _
ByVal lpReturnedString As String, ByVal nSize As Long) As Long
Function PrinterList(Optional PrinterNr As Integer = -1)
Dim i%, n%, lRet&, sBuf$, sOn$, sPort$, aPrn
Const lSize& = 1024, sKey$ = "devices"
aPrn = Split(Excel.ActivePrinter)
sOn = " " & aPrn(UBound(aPrn) - 1) & " "
sBuf = Space(lSize)
lRet = GetProfileString(sKey, vbNullString, vbNullString, sBuf, lSize)
If lRet = 0 Then Exit Function
aPrn = Split(Left(sBuf, lRet - 1), vbNullChar)
For n = LBound(aPrn) To UBound(aPrn)
sBuf = Space(lSize)
lRet = GetProfileString(sKey, aPrn(n), vbNullString, sBuf, lSize)
sPort = Mid(sBuf, InStr(sBuf, ",") + 1, lRet - InStr(sBuf, ","))
aPrn(n) = aPrn(n) & sOn & sPort
Next
' qSort aPrn
If PrinterNr = -1 Then PrinterList = aPrn Else PrinterList = aPrn( _
PrinterNr)
End Function
Public Sub qSort(v, Optional n& = True, Optional m& = True)
Dim i&, j&, p, t
If n = True Then n = LBound(v): If m = True Then m = UBound(v)
i = n: j = m: p = v((n + m) \ 2)
While (i p And j > n): j = j - 1: Wend
If (i
Gruß Ingolf