Ooit gevonden in een van de nieuwsgroepen over Excel. Als je in een netwerk hangt waarbinnen meerdere printers zijn geïnstalleerd, is het handig om de JUISTE printer te vinden. In onderstaand voorbeeld wordt naar de HP Photosmart gezocht en selecteert deze. Eenmaal geselecteerd kun je die gebruiken om je document af te drukken.
Let op ! ! !
Op 64-bit systemen gebruik je het woord ptrSafe in de declaratiesectie Private Declare PtrSafe Function etc. Op 32-bit systemen kun je dat woord wissen.
‘******************************************************************
‘Geschreven door keepITcool
‘Vereist xl2000 of nieuwer.
‘Geeft als resultaat een zerobased matrix van geïnstalleerde printers
‘De resultaten worden gefilterd op basis van het argument “Match string” (niet hoofdletter gevoelig),
‘Indien geen resultaten dan is de bovengrens -1
‘******************************************************************
Option Explicit
Private Declare PtrSafe 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
Sub test()
Dim vaList
'Get all printers
vaList = PrinterFind
'Show me
MsgBox Join(vaList, vbLf), , "List of printers"
'Get all HP Photosmart printers
vaList = PrinterFind(Match:="Photosmart")
'Switch to the first Photosmart found
If UBound(vaList) = -1 Then
MsgBox "Printer not found"
ElseIf MsgBox( _
"from " & vbTab & ": " & ActivePrinter & vbLf & "to " & _
vbTab & ": " & vaList(0), vbOKCancel, _
"Switch Printers") = vbOK Then
Application.ActivePrinter = vaList(0)
End If
End Sub
Public Function PrinterFind(Optional Match As String) As Variant
Dim n%, lRet&, sBuf$, sCon$, aPrn
Const lLen& = 1024, sKey$ = "devices"
'******************************************************************
'Geschreven door keepITcool
'Vereist xl2000 of nieuwer.
'Geeft als resultaat een zerobased matrix van geïnstalleerde printers
'De resultaten worden gefilterd op basis van het argument "Match string" (niet hoofdletter gevoelig),
'Indien geen resultaten dan is de bovengrens -1
'******************************************************************
'Split ActivePrinter string to get localized word for "on"
aPrn = Split(Excel.ActivePrinter)
sCon = " " & aPrn(UBound(aPrn) - 1) & " "
'Read all installed printers (1k bytes s/b enough)
sBuf = Space(lLen)
lRet = GetProfileString(sKey, vbNullString, vbNullString, sBuf, lLen)
If lRet = 0 Then
Err.Raise vbObjectError + 513, , "Can't read Profile"
Exit Function
End If
'Split buffer string to a zero based array
aPrn = Split(Left(sBuf, lRet - 1), vbNullChar)
'Optionally Filter the array on Match
If Match <> vbNullString Then aPrn = Filter(aPrn, Match, -1, 1)
'Append localized "on" and 16bit portname for each Printer
For n = LBound(aPrn) To UBound(aPrn)
sBuf = Space(lLen)
lRet = GetProfileString(sKey, aPrn(n), vbNullString, sBuf, lLen)
aPrn(n) = aPrn(n) & sCon & _
Mid(sBuf, InStr(sBuf, ",") + 1, lRet - InStr(sBuf, ","))
Next
'Return the result
PrinterFind = aPrn
End Function
