Public Property Let DocumentName(sDocName As String)

Sets the document name to appear in the print queue under Windows. By default this is the Project Name.

Public Property Get DocumentName() As String

Public Function IsPrinterReady() As Boolean

Public Sub LoadPrinterCombo(cmb As ComboBox)

Load all the installed printer names into a combo box.

Public Sub SetPrinterByName(sName As String)

Sets the current Printer object to the printer name specified by sName. If the printer name is not found it will raise an error.

Public Sub StartJob()
Public Sub EndJob()

This sample will shows a sample printer selection form. It assumed you have added a combo box called cmbPrinters and a command button called cmdPrint and a textbox called txtDocName (which contains the name of the document you are printing).

Dim ptr As cPrinters

Private Sub cmbPrinter_Click()
    ptr.SetPrinterByName cmbPrinter.Text
End Sub

Private Sub cmdPrint_Click()
    If ptr.IsPrinterReady Then
        ptr.DocumentName = txtDocName.Text
        ptr.StartJob
        On Error GoTo Handler
        Printer.Print "test printout1."
        ' print more stuff here.
        ptr.EndJob
        MsgBox "Print job has completed."
    Else
        MsgBox "Could not print to " & cmbPrinter.Text
    End If
    Exit Sub

Handler:
    MsgBox "An error occurred while trying to print the document.  The document will be removed from the print queue."
    ptr.EndJob
End Sub

Private Sub Form_Load()
    Set ptr = New cPrinters
    ptr.LoadPrinterCombo cmbPrinter
End Sub

Create a new CLASS module and paste this source code into it. You should name this class module cPrinters. If you have any questions, email us at help@codeoftheweek.com

'----------------------------------------------------------------------
'
'   Module Name:    cPrinters
'   Written By:     C&D Programming Corp.
'   Create Date:    7/99
'   Copyright:      Copyright 1999 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit
Private msAppTitle As String    ' stores the application title in
                                '   case someone changes the document name
Private msDocName As String     ' current document name

Public Sub LoadPrinterCombo(cmb As ComboBox)
    Dim p As Printer

    cmb.Clear

    For Each p In Printers
        cmb.AddItem p.DeviceName '& " on " & p.Port
        If Printer.DeviceName = p.DeviceName Then
            cmb.ListIndex = cmb.NewIndex
        End If
    Next
End Sub

Public Property Let DocumentName(sDocName As String)
    msDocName = sDocName
End Property

Public Property Get DocumentName() As String
    DocumentName = msDocName
End Property

Public Sub SetPrinterByName(sName As String)
    Dim p As Printer
    Dim bFound As Boolean

    On Error GoTo Handler

    ' make sure that any open job is closed.
    Printer.EndDoc

    bFound = False
    For Each p In Printers
        If sName = p.DeviceName Then

            ' assign new printer
            On Error Resume Next
            Set Printer = p
            If Err Then
                Err.Raise Err.Number, "SetPrinterByName", "Could not set the default printer.  " & Err.Description
            End If
            bFound = True
            Exit For
        End If
    Next
    If Not bFound Then
        Err.Raise 5, "SetPrinterByName", "Could not find the printer named: " & sName & ".  The error message is '" & Err.Description & "'"
    End If
    Exit Sub

Handler:
    Err.Raise Err.Number, "SetPrinterByName", "Error while attempting to set default printer: " & Err.Description
End Sub

Public Function IsPrinterReady() As Boolean
    On Error Resume Next
    Printer.Print ""
    If Err Then
        Err.Clear
        IsPrinterReady = False
        Printer.KillDoc
    Else
        IsPrinterReady = True
        Printer.KillDoc
    End If
End Function

Public Sub StartJob()
    App.Title = DocumentName
End Sub

Public Sub EndJob()
    On Error GoTo Handler
    Printer.EndDoc
    App.Title = msAppTitle
    Exit Sub

Handler:
    App.Title = msAppTitle
    Err.Raise Err.Number, "EndJob", Err.Description
End Sub

Private Sub Class_Initialize()
    msAppTitle = App.Title
    msDocName = App.Title    ' the default name is the application title.
End Sub

Private Sub Class_Terminate()
    App.Title = msAppTitle
End Sub