Results 1 to 3 of 3
  1. #1
    2 Star Lounger
    Join Date
    Jun 2002
    Posts
    122
    Thanks
    1
    Thanked 0 Times in 0 Posts
    Hi all,

    One of our users has reported an issues and it has me stumped. We have printing macros for our users to help them print letters. We have the following module:

    [codebox]Option Explicit
    ' Win32 API declares
    Private Declare Function OpenPrinter Lib "winspool.drv" _
    Alias "OpenPrinterA" (ByVal pPrinterName As String, _
    phPrn As Long, pDefault As Any) As Long

    Private Declare Function ClosePrinter Lib "winspool.drv" _
    (ByVal hPrn As Long) As Long
    Private 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

    Private 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
    Private Declare Sub CopyMemory Lib "kernel32" _
    Alias "RtlMoveMemory" (Destination As Any, _
    Source As Any, ByVal Length As Long)

    Private Declare Function lstrlenA Lib "kernel32" _
    (ByVal lpString As Long) As Long
    Private Declare Function FormatMessage Lib "kernel32" _
    Alias "FormatMessageA" (ByVal dwFlags As Long, _
    lpSource As Any, ByVal dwMessageId As Long, _
    ByVal dwLanguageId As Long, ByVal lpBuffer As String, _
    ByVal nSize As Long, Arguments As Long) As Long
    ' The data area passed to a system call is too small.
    Private Const ERROR_INSUFFICIENT_BUFFER As Long = 122
    ' Printer status flags used with PRINTER_INFORMATION_2
    Private Const PRINTER_STATUS_READY As Long = &H0
    Private Const PRINTER_STATUS_PAUSED As Long = &H1
    Private Const PRINTER_STATUS_ERROR As Long = &H2
    Private Const PRINTER_STATUS_PENDING_DELETION As Long = &H4
    Private Const PRINTER_STATUS_PAPER_JAM As Long = &H8
    Private Const PRINTER_STATUS_PAPER_OUT As Long = &H10
    Private Const PRINTER_STATUS_MANUAL_FEED As Long = &H20
    Private Const PRINTER_STATUS_PAPER_PROBLEM As Long = &H40
    Private Const PRINTER_STATUS_OFFLINE As Long = &H80
    Private Const PRINTER_STATUS_IO_ACTIVE As Long = &H100
    Private Const PRINTER_STATUS_BUSY As Long = &H200
    Private Const PRINTER_STATUS_PRINTING As Long = &H400
    Private Const PRINTER_STATUS_OUTPUT_BIN_FULL As Long = &H800
    Private Const PRINTER_STATUS_NOT_AVAILABLE As Long = &H1000
    Private Const PRINTER_STATUS_WAITING As Long = &H2000
    Private Const PRINTER_STATUS_PROCESSING As Long = &H4000
    Private Const PRINTER_STATUS_INITIALIZING As Long = &H8000
    Private Const PRINTER_STATUS_WARMING_UP As Long = &H10000
    Private Const PRINTER_STATUS_TONER_LOW As Long = &H20000
    Private Const PRINTER_STATUS_NO_TONER As Long = &H40000
    Private Const PRINTER_STATUS_PAGE_PUNT As Long = &H80000
    Private Const PRINTER_STATUS_USER_INTERVENTION As Long = &H100000
    Private Const PRINTER_STATUS_OUT_OF_MEMORY As Long = &H200000
    Private Const PRINTER_STATUS_DOOR_OPEN As Long = &H400000
    Private Const PRINTER_STATUS_SERVER_UNKNOWN As Long = &H800000
    Private Const PRINTER_STATUS_POWER_SAVE As Long = &H1000000
    ' Used to retrieve last API error text.
    Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
    ' VBA-friendly structure used to return the printer info.
    Public Type PrinterInfo
    ServerName As String
    sharename As String
    PortName As String
    drivername As String
    Comment As String
    Location As String
    SepFile As String
    PrintProcessor As String
    Datatype As String
    Parameters As String
    Status As String
    Jobs As Long
    End Type
    ' Structure used to obtain the data from Windows.
    Private Type PRINTER_INFO_2
    pServerName As Long
    pPrinterName As Long
    pShareName As Long
    pPortName As Long
    pDriverName As Long
    pComment As Long
    pLocation As Long
    pDevMode As Long 'DEVMODE
    pSepFile As Long
    pPrintProcessor As Long
    pDatatype As Long
    pParameters As Long
    pSecurityDescriptor As Long 'SECURITY_DESCRIPTOR
    Attributes As Long
    Priority As Long
    DefaultPriority As Long
    StartTime As Long
    UntilTime As Long
    Status As Long
    cJobs As Long
    AveragePPM As Long
    End Type
    Public Function GetPrinterDetails(Optional ByVal PrinterName As Variant) As PrinterInfo
    Dim pi2 As PRINTER_INFO_2
    Dim pi2_output As PrinterInfo
    Dim hPrn As Long
    Dim Buffer() As Byte
    Dim BytesNeeded As Long
    Dim BytesUsed As Long
    Dim slash As Long
    Dim DispName As String
    Dim PrinterErrorCode As Long
    Dim StatusCode As Long

    'Use default printer if none specified


    If IsMissing(PrinterName) Then
    PrinterName = ActivePrinter
    PrinterName = Left$(PrinterName, InStr(PrinterName, " on ") - 1)
    End If

    ' Get handle to printer.
    Call OpenPrinter(PrinterName, hPrn, ByVal 0&)
    If hPrn Then
    ' Call once to get proper buffer size.
    Call GetPrinter(hPrn, 2, ByVal 0&, 0, BytesNeeded)
    If Err.LastDllError = ERROR_INSUFFICIENT_BUFFER Then
    ' Size buffer and get printer data.
    ReDim Buffer(0 To BytesNeeded - 1) As Byte
    If GetPrinter(hPrn, 2, Buffer(0), BytesNeeded, BytesUsed) Then
    ' Fill local structure with data/pointers.
    Call CopyMemory(pi2, Buffer(0), Len(pi2))
    ' Transfer string data to output structure.
    pi2_output.ServerName = PointerToStringA(pi2.pServerName)
    pi2_output.sharename = PointerToStringA(pi2.pShareName)
    pi2_output.PortName = PointerToStringA(pi2.pPortName)
    pi2_output.drivername = PointerToStringA(pi2.pDriverName)
    pi2_output.Comment = PointerToStringA(pi2.pComment)
    pi2_output.Location = PointerToStringA(pi2.pLocation)
    pi2_output.SepFile = PointerToStringA(pi2.pSepFile)
    pi2_output.PrintProcessor = PointerToStringA(pi2.pPrintProcessor)
    pi2_output.Datatype = PointerToStringA(pi2.pDatatype)
    pi2_output.Parameters = PointerToStringA(pi2.pParameters)
    Call CopyMemory(StatusCode, Buffer(72), 4)
    Call CopyMemory(pi2_output.Jobs, Buffer(76), 4)
    End If
    PrinterErrorCode = 0 'clear error value
    Else
    PrinterErrorCode = Err.LastDllError
    End If
    pi2_output.Status = StatusText(StatusCode, PrinterErrorCode)
    Call ClosePrinter(hPrn)
    End If

    GetPrinterDetails = pi2_output
    End Function
    Private Function PointerToStringA(ByVal lpStringA As Long) As String
    Dim Buffer() As Byte
    Dim nLen As Long

    If lpStringA Then
    nLen = lstrlenA(ByVal lpStringA)
    If nLen Then
    ReDim Buffer(0 To (nLen - 1)) As Byte
    CopyMemory Buffer(0), ByVal lpStringA, nLen
    PointerToStringA = StrConv(Buffer, vbUnicode)
    End If
    End If
    End Function
    Private Function StatusText(StatusCode As Long, ErrorCode As Long) As String
    If ErrorCode Then
    StatusText = ApiErrorText(ErrorCode)
    Else
    Select Case StatusCode
    Case PRINTER_STATUS_READY
    StatusText = "Ready"
    Case PRINTER_STATUS_PAUSED
    StatusText = "Paused"
    Case PRINTER_STATUS_ERROR
    StatusText = "Error"
    Case PRINTER_STATUS_PENDING_DELETION
    StatusText = "Deleting..."
    Case PRINTER_STATUS_PAPER_JAM
    StatusText = "Paper Jam"
    Case PRINTER_STATUS_PAPER_OUT
    StatusText = "Paper Out"
    Case PRINTER_STATUS_MANUAL_FEED
    StatusText = "Manual Feed Required"
    Case PRINTER_STATUS_PAPER_PROBLEM
    StatusText = "Paper Problem"
    Case PRINTER_STATUS_OFFLINE
    StatusText = "Offline"
    Case PRINTER_STATUS_IO_ACTIVE
    StatusText = "Downloading Job"
    Case PRINTER_STATUS_BUSY
    StatusText = "Busy"
    Case PRINTER_STATUS_PRINTING
    StatusText = "Printing"
    Case PRINTER_STATUS_OUTPUT_BIN_FULL
    StatusText = "Output Bill Full"
    Case PRINTER_STATUS_NOT_AVAILABLE
    StatusText = "Not Available"
    Case PRINTER_STATUS_WAITING
    StatusText = "Waiting"
    Case PRINTER_STATUS_PROCESSING
    StatusText = "Processing Job"
    Case PRINTER_STATUS_INITIALIZING
    StatusText = "Initializing"
    Case PRINTER_STATUS_WARMING_UP
    StatusText = "Warming Up"
    Case PRINTER_STATUS_TONER_LOW
    StatusText = "Toner Low"
    Case PRINTER_STATUS_NO_TONER
    StatusText = "Toner Out"
    Case PRINTER_STATUS_PAGE_PUNT
    StatusText = "Page too Complex"
    Case PRINTER_STATUS_USER_INTERVENTION
    StatusText = "User Intervention Required"
    Case PRINTER_STATUS_OUT_OF_MEMORY
    StatusText = "Out of Memory"
    Case PRINTER_STATUS_DOOR_OPEN
    StatusText = "Door Open"
    Case PRINTER_STATUS_SERVER_UNKNOWN
    StatusText = "Unable to connect"
    Case PRINTER_STATUS_POWER_SAVE
    StatusText = "Power Save Mode"
    Case Else
    StatusText = Hex$(StatusCode)
    End Select
    End If
    End Function
    Private Function ApiErrorText(ByVal ErrNum As Long) As String
    Dim msg As String
    Dim nRet As Long
    msg = Space$(1024)
    nRet = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, ErrNum, 0&, msg, Len(msg), ByVal 0&)
    If nRet Then
    ApiErrorText = Left$(msg, nRet - 2) ' account for Cr/Lf
    Else
    ApiErrorText = "Error (" & ErrNum & ") not defined."
    End If
    End Function[/codebox]

    Then this further macro that our users access via a userform:

    [codebox]Sub printletter()

    'running this macro will produce both a letterhead and draft print out of a letter

    Dim drivername, sharename, reply1
    drivername = GetPrinterDetails.drivername
    sharename = GetPrinterDetails.sharename

    Dim strActivePrinter As String
    Dim strNewPrinter As String
    Dim intPos As Integer

    Dim MyWord, mydocid As Object
    Set MyWord = GetObject(, "Word.Application")

    'this minimizes then maximizes the activedocument to update footertext for printing
    Set mydocid = MyWord.ActiveDocument
    mydocid.ActiveWindow.WindowState = wdWindowStateMinimize
    mydocid.ActiveWindow.Activate
    mydocid.ActiveWindow.WindowState = wdWindowStateMaximize
    mydocid.ActiveWindow.Activate

    'Get currently active printer - if already single, code jumps to activedocument.printout
    strActivePrinter = Application.ActivePrinter

    'if active printer is duplex, change to single
    intPos = InStr(strActivePrinter, " ")

    If Mid(strActivePrinter, intPos - 1, 1) = "d" Then
    strNewPrinter = Left(strActivePrinter, intPos - 2)
    Application.ActivePrinter = strNewPrinter
    End If

    Select Case drivername
    Case "HP LaserJet 8150 PCL 6" 'WindowsXP, LaserJet 8150
    mdlettertray = wdPrinterLowerBin
    mdconttray = wdPrinterLargeCapacityBin
    mddrafttray = 256
    Case "HP LaserJet 5Si" 'WindowsXP, LaserJet 5Si
    mdlettertray = wdPrinterUpperBin
    mdconttray = wdPrinterLowerBin
    mddrafttray = wdLargeCapacityBin
    Case "HP LaserJet 8000 Series PCL 6" 'WindowsXP, LaserJet 8000
    mdlettertray = wdPrinterMiddleBin
    mdconttray = wdPrinterLargeCapacityBin
    mddrafttray = 256
    Case "HP LaserJet 4050 Series PCL 6" 'WindowsXP, HP Laserjet 4050 PCL 6'
    confirm = "Please note that this is a TWO tray printer." & Chr$(13) & _
    "You must ensure that the printer is loaded as follows:" & Chr$(13) & _
    "Manual Tray" & Chr$(9) & "= Draft" & Chr$(13) & "Tray 2" & Chr$(9) & Chr$(9) & _
    "= Letterhead" & Chr$(13) & "Tray 3" & Chr$(9) & Chr$(9) & _
    "= Continuation" & Chr$(13) & confirm
    mddrafttray = wdPrinterManualFeed
    mdlettertray = wdPrinterLowerBin
    mdconttray = wdPrinterLargeCapacityBin
    Case "HP LaserJet 4100 PCL 6" 'WindowsXP, HP Laserjet 4100 PCL 6'
    confirm = "Please note that this is a TWO tray printer." & Chr$(13) & _
    "You must ensure that the printer is loaded with paper as follows:" & Chr$(13) & _
    "Manual Tray" & Chr$(9) & "= Letterhead" & Chr$(13) & "Tray 2" & Chr$(9) & Chr$(9) & _
    "= Continuation" & Chr$(13) & "Tray 3" & Chr$(9) & Chr$(9) & _
    "= Draft" & Chr$(13) & confirm
    mddrafttray = wdPrinterLargeCapacityBin
    mdlettertray = wdPrinterUpperBin
    mdconttray = wdPrinterLowerBin
    Case "HP LaserJet 4200 PCL 6" 'WindowsXP, HP Laserjet 4200 PCL 6'
    confirm = "Please note that this is a TWO tray printer." & Chr$(13) & _
    "You must ensure that the printer is loaded as follows:" & Chr$(13) & _
    "Manual Tray" & Chr$(9) & "= Draft" & Chr$(13) & "Tray 2" & Chr$(9) & Chr$(9) & _
    "= Letterhead" & Chr$(13) & "Tray 3" & Chr$(9) & Chr$(9) & _
    "= Continuation" & Chr$(13) & confirm
    mddrafttray = 262
    mdlettertray = 263
    mdconttray = 264
    Case "Canon iR3570/iR4570 PCL6" 'WindowsXP, Canon iR3570/iR4570 PCL 6'
    mddrafttray = wdPrinterLowerBin
    mdlettertray = wdPrinterUpperBin
    mdconttray = wdPrinterMiddleBin
    Case "Canon iR C3220 PCL5c" 'WindowsXP, Canon iR3220 PCL5c
    mddrafttray = wdPrinterLowerBin
    mdlettertray = wdPrinterUpperBin
    mdconttray = wdPrinterMiddleBin
    Case "HP LaserJet 9040 PCL 6" 'WindowsXP, LaserJet 9040
    mdlettertray = 259
    mdconttray = 258
    mddrafttray = 257
    Case "Canon iR8070 PCL6" 'WindowsXP, Canon 8070
    mdlettertray = wdPrinterUpperBin
    mdconttray = wdPrinterMiddleBin
    mddrafttray = 265
    Case "Canon iR C5185 PCL6"
    mddrafttray = wdPrinterLowerBin
    mdlettertray = wdPrinterUpperBin
    mdconttray = wdPrinterMiddleBin
    Case Else 'All other variations
    mdlettertray = wdPrinterMiddleBin
    mdconttray = wdPrinterLowerBin
    mddrafttray = wdPrinterLargeCapacityBin
    End Select

    reply1 = MsgBox("You are about to print to " & GetPrinterDetails.sharename & _
    ". Continue?", vbYesNo, "McGrigors Office")
    If reply1 = vbYes Then
    Selection.HomeKey Unit:=wdStory

    'if the printer is an HP, change the left margin to 2.75cm
    If drivername Like "*LaserJet*" Then
    ActiveDocument.PageSetup.LeftMargin = CentimetersToPoints(2.75)
    End If

    'determine number of pages
    pages = ActiveDocument.BuiltInDocumentProperties(wdPropert yPages)
    Options.PrintBackground = False

    'ONE PAGE LETTERS
    'determine no of pages and change paper trays to pick up letterhead within page setup
    If pages = 1 Then
    With ActiveDocument.PageSetup
    .FirstPageTray = mdlettertray
    .OtherPagesTray = mdconttray
    End With

    'print letter copy
    ActiveDocument.PrintOut

    ActiveDocument.BuiltInDocumentProperties(wdPropert yCompany) = "McGrigors LLP"
    Selection.HomeKey Unit:=wdStory

    'determine margins and change paper trays back to draft in page setup
    With ActiveDocument.PageSetup
    .SectionStart = wdSectionNewPage
    .DifferentFirstPageHeaderFooter = True
    .FirstPageTray = mddrafttray
    .OtherPagesTray = mddrafttray
    End With

    'print draft copy
    ActiveDocument.PrintOut
    Options.PrintBackground = True

    Else

    'MULTI PAGE LETTERS
    'determine margins and change paper trays to pick up letterhead/continuation
    'in page setup
    With ActiveDocument.PageSetup
    .FirstPageTray = mdlettertray
    .OtherPagesTray = mdconttray
    End With

    'print letter copy
    ActiveDocument.PrintOut

    ActiveDocument.BuiltInDocumentProperties(wdPropert yCompany) = "McGrigors LLP"

    Rem insert delay to allow print job to start before changing to draft tray
    For Counter = 1 To 15000
    Next
    With ActiveDocument.PageSetup 'changing back to draft paper trays here
    .DifferentFirstPageHeaderFooter = True
    .FirstPageTray = mddrafttray
    .OtherPagesTray = mddrafttray
    End With

    Selection.HomeKey Unit:=wdStory

    'print draft copy
    ActiveDocument.PrintOut
    Options.PrintBackground = True

    'if the printer is an HP, change the left margin back to 2.85cm
    If drivername Like "*LaserJet*" Then
    ActiveDocument.PageSetup.LeftMargin = CentimetersToPoints(2.85)
    End If

    ActiveDocument.BuiltInDocumentProperties(wdPropert yCompany) = "McGrigors LLP"

    End If
    End If

    ExitHandler:
    On Error Resume Next
    'Restore original printer
    Application.ActivePrinter = strActivePrinter
    ' Exit Sub
    '
    'ErrHandler:
    ' MsgBox Err.Description, vbExclamation
    ' Resume ExitHandler

    Application.ScreenUpdating = True
    End
    End Sub[/codebox]

    The issue is this:

    • the user's default window printer is printer X;

    • working on a document, they change their word active printer to printer Y;

    • they then create a letter and use the printletter macro which results in the windows default printer becoming printer Y.


    Can anyone tell me why it's changing the windows default printer?

    Thanks in advance!

    Violet

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    Apparently, the module containing the printletter macro doesn't have a line Option Explicit at the beginning, for there are many undeclared variables. Moreover, the code uses a non-existent constant wdLargeCapacityBin. This should be wdPrinterLargeCapacityBin.

    It looks like the macro originally contained an error handler that ensured that the printer would always be reset to the original one. However, there is no line

    On Error GoTo ErrHandler

    any more, so if an error occurs, the default printer will remain as set by the code.

  3. #3
    2 Star Lounger
    Join Date
    Jun 2002
    Posts
    122
    Thanks
    1
    Thanked 0 Times in 0 Posts
    You are right, the module that contains the printletter macro doesn't have option explicit anywhere. I was just working it out there and this macro was originally created 10 (!) years ago and is still going, having passed through many many hands and now being in mine!

    Many thanks (as ever) for your valuable advice, I'm off to do some tinkering based on what you've said - I'll get back to you on the outcome...

    Violet

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •