Re: List of printers
From: keepITcool (xrrcvgpbby_at_puryyb.ay)
Date: 01/22/05
- Next message: keepITcool: "Re: DataObject and cliboard"
- Previous message: D.2: "DataObject and cliboard"
- In reply to: Tom: "List of printers"
- Messages sorted by: [ date ] [ thread ]
Date: Sat, 22 Jan 2005 11:37:39 -0800
Hi Thomas
This should produce exactly what you're looking for
but note it will NOT work for xl97
The PrinterFind function will return an array of
localized strings ready to assign to the ActivePrinter.
I've amended an old post from myself to allow filtering.
see test procedure for example of how to use.
On a userform you could simply use s'th like
cboPrinters.list=PrinterFind
Option Explicit
Private 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
Sub Test()
Dim vaList
'Get all printers
vaList = PrinterFind
'Show m
MsgBox Join(vaList, vbLf), , "List of printers"
'Get all laserjets
vaList = PrinterFind(Match:="Laserjet")
'Switch to the first laserjet 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 String()
Dim n%, lRet&, sBuf$, sCon$, aPrn$()
Const lLen& = 1024, sKey$ = "devices"
'------------------------------------------------------------------
'written by keepITcool
'requires xl2000 or newer.
'returns a zerobased array of complete localized printer strings
'results are filtered on Match string, if no result the ubound = -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
aPrn = Split(Left(sBuf, lRet - 1), vbNullChar)
'Filter array on Match
If Match <> vbNullString Then aPrn = Filter(aPrn, Match, -1, 1)
For n = LBound(aPrn) To UBound(aPrn)
'Add 16bit portname for each Printer
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
--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam
Tom wrote :
> Hi
>
> I'd like to get a array of all installed printers incl. the connected
> port. The array should look like this:
>
> HP LaserJet 6P on LPT1:
> Adobe PDF on Ne03:
> SnagIt 6 on Ne00:
>
>
> I already have the following procedure, but this code doesn't return
> the connected port:
>
> Private Sub ListPrinters()
> Dim wshNetwork As Object
> Dim oDrives As Object
> Dim oPrinters As Object
> Dim iCount As Integer
> Dim sCurrentprinter As String
> sCurrentprinter = Application.ActivePrinter
> Set wshNetwork = CreateObject("WScript.Network")
> Set oDrives = wshNetwork.EnumNetworkDrives
> Set oPrinters = wshNetwork.EnumPrinterConnections
> For iCount = 0 To oPrinters.Count - 1 Step 2
> Debug.Print oPrinters.Item(iCount + 1)
> Next
> End Sub
>
>
> Many thanks in advance.
>
> Tom
- Next message: keepITcool: "Re: DataObject and cliboard"
- Previous message: D.2: "DataObject and cliboard"
- In reply to: Tom: "List of printers"
- Messages sorted by: [ date ] [ thread ]
Relevant Pages
|
