Change the Default Printer

'************************
' Printer setup module
' Set/retrieves the default printer - originaly for VB6
' Works for A97/2003
' 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   GetDefaultPrinter
' To set the default printer
'        debug.print SetDefaultPrinter("HP Laser JET")
'  above returns true if success.
' To get a list of printers suitable for a listbox, or combo
'        debug.print GetPrinters
'
' that is all there folks!
'
' Thus, when printing a report, you can:
'
'       1) save the default printer into a string
'              strCurrentPtr = GetDefaultPrinter
'       2) switch to your report printer
'              SetDefaultPrinter strReportsPtr
'       3) print report
'       4) switch back to the default printer
'              SetDefaultPrinter 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
   
         

Function SetDefaultPrinter(strPrinterName As String) As Boolean
   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)
     SetDefaultPrinter = 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
     SetDefaultPrinter = False
  End If
End Function

Function GetDefaultPrinter() As String
   Dim strDefault    As String
   Dim lngbuf        As Long
   strDefault = String(255, Chr(0))
   lngbuf = GetProfileString("Windows", "Device", "", strDefault, Len(strDefault))
   If lngbuf > 0 Then
      GetDefaultPrinter = fstrDField(strDefault, ",", 1)
   Else
      GetDefaultPrinter = ""
   End If
End Function

Function GetPrinters() 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 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 GetPrinters <> "" Then GetPrinters = GetPrinters & ";"
        GetPrinters = GetPrinters & strOnePtr
        intPos = InStr(strBuffer, Chr(0))
     Loop
   Else
      GetPrinters = ""
   End If
 End Function

Public Function testPrintersGet()
   Debug.Print GetDefaultPrinter
   Debug.Print GetPrinters
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

'Declare a global variable to restore your default printer
Option Explicit
Dim gblMyDefaultPrinter as String

Private Sub Form_Load()
' Add unbound combobox to form and populate with available printers
   Me.Combo0.RowSource = GetPrinters
   Me.Combo0 = GetDefaultPrinter
'Set the users Default Printer
   gblMyDefaultPrinter = GetDefaultPrinter
End Sub

Private Sub Combo0_AfterUpdate()
   SetDefaultPrinter (Me.Combo0)
End Sub

Private Sub Form_Unload(Cancel As Integer)
'Reset the printer back to the user's default.
SetDefaultPrinter (gblMyDefaultPrinter)
End Sub