Neuraxis..


I think you completely missed the point of my code.
Worse: your code doesnt work.

By removing the localized LOCATION string and the PORT to which the
printer is attached, you've fatally crippled it.

Excel's Activeprinter needs a complete (localized) string to reliably
work, and my (original) function provides it.
For versatility it can return an array for use in comboboxes,
or a filtered list to directly set the printer.


Assuming the target printer string is:

"HP LaserJet 5000 Series PCL6 on NE00:"


The calling code for my function would be:

Application.activeprinter = PrinterFind("laserjet 5000")(0)


it is case insentive
it accepts partial printer names...
it works in all excel language versions.
it works for xl2000+ (adapting it for xl97 is not difficult)


Your adaptation should work like:
SetActivePrinter("HP Laserjet 5000 Series PCL6")
(Case sensitive, complete name required)


I'd stick to my ORIGINAL printerFind, but if you want a wrapper then I
suggest:

Sub SetActivePrinter(sName as string)
dim sOri$
sOri = application.activeprinter
on error resume next
application.activeprinter = PrinterFind(sName)(0)
on error goto 0
if application.activeprinter < sOri then
MsgBox "Couldnt set the activeprinter"
end if

End sub




--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Neuraxis wrote :
Thank you for your information. I have modified your code below to
create a function called SetActivePrinter which you can pass a string
to in order to set the printer to a string.

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 SetActivePrinter(TargetPrinter As String)

Dim vaList
Dim i As Integer

'Get all printers
vaList = PrinterFind

'Get all printers
vaList = PrinterFind()

MsgBox UBound(vaList)

'Find array index of printer
For i = 0 To UBound(vaList)
If vaList(i) = TargetPrinter Then
Application.ActivePrinter = vaList(i)
End If
Next

End Sub


Public Function PrinterFind() As String()
Dim n%, lRet&, sBuf$, sCon$, aPrn$()
Const lLen& = 1024, sKey$ = "devices"

'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)

'Return printer array
PrinterFind = aPrn

End Function