You don't have to take my word. You can test it yourself. Both Excel and
Word support application.ActivePrinter
In word
? application.ActivePrinter
\\006-pm2-fs02\PRN4N3 on NE02:
' now change to another manually
? application.ActivePrinter
\\006-pm2-fs02\prn4n1 on NE01:
Now set it back with code
application.ActivePrinter = "\\006-pm2-fs02\PRN4N3"
In Excel
? application.ActivePrinter
\\006-pm2-fs02\prn4n1 on Ne01:
' now change to another manually
? application.ActivePrinter
\\006-pm2-fs02\PRN4N3 on Ne02:
Now set it back with code:
Application.ActivePrinter = "\\006-pm2-fs02\prn4n1"
Raises an error
but this works:
Application.ActivePrinter = "\\006-pm2-fs02\prn4n1 on Ne01:"
of course in word, adding the "on Ne01:" also works, so Word is more
flexible.
From what I have read in a discussion here, Access is different again.
While I like your idea of brute force testing, KeepItCool has posted this
code for Excel which seems to work.
http://groups.google.com/[email protected]&output=gpl
Newsgroups: microsoft.public.excel.programming
Subject: Re: COMBOBOX WITH PRINTERS LIST
From: keepitcool <
[email protected]>
References: <
[email protected]>
Organization: xlSupport.com
Message-ID: <
[email protected]>
User-Agent: Xnews/5.04.25
Lines: 119
Date: Wed, 26 May 2004 06:45:47 GMT
NNTP-Posting-Host: 24.132.231.213
X-Complaints-To: (e-mail address removed)
X-Trace: amsnews02.chello.com 1085553947 24.132.231.213 (Wed, 26 May 2004
08:45:47 MEST)
NNTP-Posting-Date: Wed, 26 May 2004 08:45:47 MEST
Christian..
the function below returns an array of the installed printers
( in complete localized strings)
Can be called when you're filling a combobox on a form or in a dropdown
from worksheet as in demo (as in the demo)
Sub Demo()
Dim v As Variant
Dim i As Long
Workbooks.Add xlWBATWorksheet
v = PrinterList
For i = LBound(v) To UBound(v)
Cells(i + 1, 1) = v(i)
Cells(i + 1, 2).Formula = "=printerlist(" & i & ")"
Next
Cells(1, 3).Resize(i, 1).FormulaArray = "=transpose(printerlist())"
Cells(1, 4).Resize(1, i).FormulaArray = "=printerlist()"
Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
MsgBox Join(v, vbNewLine)
End Sub
Function PrinterList(Optional PrinterNr As Integer = -1)
Dim i%, n%, lRet&, sBuf$, sOn$, sPort$, aPrn
Const lSize& = 1024, sKey$ = "devices"
'-----------------------------------------------------------
'Author: keepITcool 1st posted nl.office.excel 23/10/2003
'Function returns a zerobased array of installed printers
'include for xl97: supplemental functions split/join/replace
'-----------------------------------------------------------
'Get localized Connection string
aPrn = Split(Excel.ActivePrinter)
sOn = " " & aPrn(UBound(aPrn) - 1) & " "
'Read Printers
sBuf = Space(lSize)
lRet = GetProfileString(sKey, vbNullString, vbNullString, sBuf, lSize)
If lRet = 0 Then Exit Function
'Make Array from String
aPrn = Split(Left(sBuf, lRet - 1), vbNullChar)
'Add Port for each Printer
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
'Sort
qSort aPrn
'Return the results
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 <= j)
While (v(i) < p And i < m): i = i + 1: Wend
While (v(j) > p And j > n): j = j - 1: Wend
If (i <= j) Then
t = v(i): v(i) = v(j): v(j) = t
i = i + 1: j = j - 1
End If
Wend
If (n < j) Then qSort v, n, j
If (i < m) Then qSort v, i, m
End Sub
'**********************************************************
' Optional Split function for xl97
'**********************************************************
#If VBA6 Then
#Else
Function Split(sText As String, _
Optional sDelim As String = " ") As Variant
Dim i%, sFml$, v0, v1
Const sDQ$ = """"
If sDelim = vbNullChar Then
sDelim = Chr(7)
sText = Replace(sText, vbNullChar, sDelim)
End If
sFml = "{""" & Application.Substitute(sText, sDelim, """,""") & """}"
v1 = Evaluate(sFml)
'Return 0 based for compatibility
ReDim v0(0 To UBound(v1) - 1)
For i = 0 To UBound(v0): v0(i) = v1(i + 1): Next
Split = v0
End Function
#End If
keepITcool
< email : keepitcool chello nl (with @ and .) >
< homepage:
http://members.chello.nl/keepitcool >
---------------------------------------------------
He also recently stated that in the split function
v1 = Evaluate(sFml)
'Return 0 based for compatibility
ReDim v0(0 To UBound(v1) - 1)
For i = 0 To UBound(v0): v0(i) = v1(i + 1): Next
Split = v0
could be replaced by
v1 = Evaluate(sFml)
ReDim Preserve v1(0 To UBound(v1) - 1)
Split = v1
