[AccessD] Printer selection

You could pick something  out  of the below.  See the first function which
runs two examples.

Max

Option Compare Database
Option Explicit

'************************
' Printer setup module
' Set/retrieves the default printer - originaly for VB6
' Works for A97/a2000
' This is minimal code.
' Albert D.Kallal - 01/13/2002
' Rev history:       Date           Who                   notes
'                    01/13/2002     Albert D. kallal
'
' I wrote this after looking at some the code on the net. Some of the
routines
' to change a printer were approaching 500 + of lines of code. Just the
printer
' constant defs was over 100 lines of code! Yikes!
' I use only TWO API's (the 3rd one is optional). There is a total of only 4
functions!
' KISS is the word. Keep it simple stupid. I don't care about device
drivers, or the
' port number. All these routines just work with the simple printer name. If
you do
' actually care about the device driver and port stuff..then use the one of
many
' examples available on the net. Those other examples also deal with
margins, orientation
' etc.
'
' You can paste this code into a module..and away you go
'
'************************
' How to use
' To get the default printer
'        ''debug.print   pfGetDefaultPrinter
' To set the default printer
'        ''debug.print pfSetDefaultPrinter("HP Laser JET")
'  above returns true if success.
' To get a list of printers suitable for a listbox, or combo
'        ''debug.print pfSelectAPrinter
'
' that is all there folks!
'
' Thus, when printing a report, you can:
'
'       1) save the default printer into a string
'              strCurrentPtr = pfGetDefaultPrinter
'       2) switch to your report printer
'              pfSetDefaultPrinter strReportsPtr
'       3) print report
'       4) switch back to the default printer
'              pfSetDefaultPrinter strCurrentPtr
'

Private Const HWND_BROADCAST As Long = &HFFFF&
Private Const WM_WININICHANGE As Long = &H1A

' The following code allows one to read, and write to the WIN.INI files
' In win 2000 the printer settings are actually in the registry. However,
windows
' handles this correctly
'
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

Private Declare Function WriteProfileString Lib "kernel32" _
                                            Alias "WriteProfileStringA" _
                                            (ByVal lpszSection As String, _
                                             ByVal lpszKeyName As String, _
                                             ByVal lpszString As String) As
Long

Private Declare Function SendMessage Lib "User32" _
                                     Alias "SendMessageA" _
                                     (ByVal hwnd As Long, _
                                      ByVal wMsg As Long, _
                                      ByVal wParam As Long, _
                                      lParam As Any) As Long

Public Function testPrintersGet()
    Debug.Print pfGetDefaultPrinter
    Debug.Print pfSelectAPrinter
End Function

Public Function pfGetSetUserPrinter()
'       1) save the default printer into a string
'              strCurrentPtr = pfGetDefaultPrinter
'       2) switch to your report printer
'              pfSetDefaultPrinter strReportsPtr
'       3) print report
'       4) switch back to the default printer
'              pfSetDefaultPrinter strCurrentPtr
  Dim strCurrentPtr As String, strPrinterWanted As String
  strCurrentPtr = pfGetDefaultPrinter()  'capture current printer
  strPrinterWanted = pfSelectAPrinter()  'ask user for which printer they
want
  Call pfSetDefaultPrinter(strCurrentPtr)  ' reset printer back to original

End Function
Private Function fstrDField(mytext As String, DELIM As String, groupnum As
Integer) As String
' this is a standard delimiter routine that every developer I know has.
' This routine has a million uses. This routine is great for splitting up
' data fields, or sending multiple parms to a openargs of a form
'
'  Parms are
'        mytext   - a delimited string
'        delim    - our delimiter (usually a , or / or a space)
'        groupnum - which of the delimited values to return
'
  Dim startpos As Integer, endpos As Integer
  Dim groupptr As Integer, chptr As Integer

  chptr = 1
  startpos = 0
  For groupptr = 1 To groupnum - 1
    chptr = InStr(chptr, mytext, DELIM)
    If chptr = 0 Then
      fstrDField = ""
      Exit Function
    Else
      chptr = chptr + 1
    End If
  Next groupptr
  startpos = chptr
  endpos = InStr(startpos + 1, mytext, DELIM)
  If endpos = 0 Then
    endpos = Len(mytext) + 1
  End If

  fstrDField = Mid$(mytext, startpos, endpos - startpos)

End Function

Public Function pfSetDefaultPrinter(strPrinterName As String) As Boolean
' set the default printer to the one selected by the user
  Application.Printer = Printers(strPrinterName)
  GoTo exithere

  Dim strDeviceLine As String
  Dim strBuffer As String
  Dim lngbuf As Long
  ' get the full device string
  strBuffer = Space(1024)
  lngbuf = GetProfileString("PrinterPorts", strPrinterName, "", strBuffer,
Len(strBuffer))

  'Write out this new printer information in
  ' WIN.INI file for DEVICE item
  If lngbuf > 0 Then

    strDeviceLine = strPrinterName & "," & _
                    fstrDField(strBuffer, Chr(0), 1) & "," & _
                    fstrDField(strBuffer, Chr(0), 2)

    Call WriteProfileString("windows", "Device", strDeviceLine)
    pfSetDefaultPrinter = True

    ' Below is optional, and should be done. It updates the existing windows
    ' so the "default" printer icon changes. If you don't do the below..then
    ' you will often see more than one printer as the default! The reason
*not*
    ' to do the SendMessage is that many open applications will now sense
the change
    ' in printer. I vote to leave it in..but your case you might not want
this.
    '
    Call SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, ByVal "windows")
  Else
    pfSetDefaultPrinter = False
  End If
exithere:
  Exit Function
End Function

Public Function pfGetDefaultPrinter() As String
' find the current default printer
  pfGetDefaultPrinter = Application.Printer.DeviceName
  GoTo exithere
  Dim strDefault As String
  Dim lngbuf As Long
  strDefault = String(255, Chr(0))
  lngbuf = GetProfileString("Windows", "Device", "", strDefault,
Len(strDefault))
  If lngbuf > 0 Then
    pfGetDefaultPrinter = fstrDField(strDefault, ",", 1)
  Else
    pfGetDefaultPrinter = ""
  End If
exithere:
  Exit Function
End Function

Public Function pfSelectAPrinter() As String

' this routine returns a list of printers, separated by
' a ";", and thus the results are suitable for stuffing into a combo box
  Dim i As Integer, prt As Printer
  i = 0
  For Each prt In Application.Printers
    'The printer number is listed for referencing the printer in code
    'debug.print i & " - " & prt.DeviceName
    pfSelectAPrinter = pfSelectAPrinter & prt.DeviceName & ";"
    i = i + 1
  Next prt
  GoTo exithere

  Dim strBuffer As String
  Dim strOnePtr As String
  Dim intPos As Integer
  Dim lngChars As Long

  strBuffer = Space(2048)
  lngChars = GetProfileString("PrinterPorts", vbNullString, "", strBuffer,
Len(strBuffer))

  If lngChars > 0 Then
    intPos = InStr(strBuffer, Chr(0))
    Do While intPos > 1
      strOnePtr = Left(strBuffer, intPos - 1)
      strBuffer = Mid(strBuffer, intPos + 1)
      If pfSelectAPrinter <> "" Then pfSelectAPrinter = pfSelectAPrinter &
";"
      pfSelectAPrinter = pfSelectAPrinter & strOnePtr
      intPos = InStr(strBuffer, Chr(0))
    Loop
  Else
    pfSelectAPrinter = ""
  End If
exithere:
  Exit Function
End Function