Source code for Issue Number 100

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. 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

Code of the Week Home

Source Code

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