ChgDefPrinter

'constant to set printer_info_5 attributes member

Public Const PRINTER_ATTRIBUTE_QUEUED = &H1 '1
Public Const PRINTER_ATTRIBUTE_DIRECT = &H2 '2
Public Const PRINTER_ATTRIBUTE_DEFAULT = &H4 '4
'Public Const PRINTER_ATTRIBUTE_DO_COMPLETE_FIRST = ?

Public Const PRINTER_ATTRIBUTE_SHARED = &H8 '8
Public Const PRINTER_ATTRIBUTE_NETWORK = &H10 '16
Public Const PRINTER_ATTRIBUTE_HIDDEN = &H20 '32
Public Const PRINTER_ATTRIBUTE_LOCAL = &H40 '64
Public Const PRINTER_ATTRIBUTE_WORK_OFFLINE = &H400 '1024
Public Const PRINTER_ATTRIBUTE_ENABLE_BIDI = &H800 '2048
Type PRINTER_INFO_5
pPrinterName As String
pPortName As String
Attributes As Long
DeviceNotSelectedTimeout As Long
TransmissionRetryTimeout As Long
End Type
Declare Function GetPrinter Lib "winspool.drv" Alias "GetPrinterA" _
(ByVal hPrinter As Long, ByVal Level As Long, pPrinter As Any, _
ByVal cbBuf As Long, pcbNeeded As Long) As Long
Declare Function SetPrinter Lib "winspool.drv" Alias "SetPrinterA" _
(ByVal hPrinter As Long, ByVal Level As Long, pPrinter As Any, _
ByVal Command As Long) As Long
Declare Function lstrcpy Lib "Kernel32" Alias "lstrcpyA" _
(ByVal lpString1 As String, ByVal lpString2 As Any) As Long
'***************************************************************************

' NAME: PrinterSetDefault

' NOTES: Make printer the default

' : Taken from Microsoft Knowledge Base article Q167735

' PARAM: hPrinter : handle of printer to set as default

' : bShowError : display an error message if printer is not

available?
' DATE: 9/29/97

'***************************************************************************

Public Function PrinterSetDefault(hPrinter As Long, bShowError As Boolean)
Dim i As Long
Dim BufferSize As Long
Dim Temp() As Long
Dim pInfo5 As PRINTER_INFO_5 'your PRINTER_INFO structure
'make an initial call to GetPrinter, requesting Level 5

'(PRINTER_INFO_5) information, to determine how many bytes needed

i = GetPrinter(hPrinter, 5, ByVal 0&, 0, BufferSize)
'don't want to check GetLastError here - it's supposed to fail

'with a 122 - ERROR_INSUFFICIENT_BUFFER

'redim t as large as you need


ReDim Temp((BufferSize \ 4)) As Long

'and call GetPrinter for keepers this time

i = GetPrinter(hPrinter, 5, Temp(0), BufferSize, BufferSize)
'failed the GetPrinter

If i = False Then
If bShowError Then MsgBox ("Failed to GetPrinter")
Exit Function
End If

'set the members of the pi5 structure for use with SetPrinter

'PtrCtoVbString copies the memory pointed at by the two string

'pointers contained in the Temp() array into a VB string.

'The other three elements are just dWords (long integers) and

'don't require any conversion

pInfo5.pPrinterName = PtrCtoVbString(Temp(0))
pInfo5.pPortName = PtrCtoVbString(Temp(1))
pInfo5.Attributes = Temp(2)
pInfo5.DeviceNotSelectedTimeout = Temp(3)
pInfo5.TransmissionRetryTimeout = Temp(4)

'this is the critical flag that makes it the default printer

pInfo5.Attributes = PRINTER_ATTRIBUTE_DEFAULT '4
' pInfo5.Attributes = PRINTER_ATTRIBUTE_QUEUED '1

' pInfo5.Attributes = PRINTER_ATTRIBUTE_DIRECT '2

' pInfo5.Attributes = PRINTER_ATTRIBUTE_SHARED '8

' pInfo5.Attributes = PRINTER_ATTRIBUTE_NETWORK '10

' pInfo5.Attributes = PRINTER_ATTRIBUTE_HIDDEN '20

' pInfo5.Attributes = PRINTER_ATTRIBUTE_LOCAL '40

' pInfo5.Attributes = PRINTER_ATTRIBUTE_WORK_OFFLINE '400

' pInfo5.Attributes = PRINTER_ATTRIBUTE_ENABLE_BIDI '800


'call SetPrinter to set it

i = SetPrinter(hPrinter, 5, pInfo5, 0)
'failed SetPrinter

If i = False Then
If bShowError Then MsgBox ("SetPrinter Failed. Error code: " &
GetLastError())
Exit Function
End If

PrinterSetDefault = True
End Function

'***************************************************************************

' NAME: PtrCtoVbString

' NOTES: Converts a pointer to a string to a VB string

' : Taken from Microsoft Knowledge Base article Q167735

' : (Be sure this is declared as follows:

' : Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" _

' : (ByVal lpString1 As String, ByVal lpString2 As Any) As Long

' PARAM: Add : pointer-to-string to convert

' DATE: 9/29/97

'***************************************************************************

Private Function PtrCtoVbString(Add As Long) As String
Dim sTemp As String * 512
Dim i As Long
i = lstrcpy(sTemp, Add)
If (InStr(1, sTemp, Chr(0)) = 0) Then
PtrCtoVbString = ""
Else
PtrCtoVbString = Left(sTemp, InStr(1, sTemp, Chr(0)) - 1)
End If

End Function