Snippet Library

'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

none;