word macro to print first page to different try

Hi,

We have a place that has a print server with a few printers attached to. I created a macro to print to different tray but we are having a problem.

This is the code: -

Code:

---

Sub PrintHp()
  LetterHeadRun ("\\jonesprint\HP 4200TN PCL 6 (2nd Floor)")
End Sub

Sub PrintSharp()
  LetterHeadRun ("\\jonesprint\SHARP AR-M351N PCL6")
End Sub

Sub LetterHeadRun(PrinterToPrintTo)

'********** Version Control **********

'This code prints the first page of a document to letter headed paper.
'Any subsequent pages are printed to plain paper.
'A copy of all pages is then printed to plain paper.
'Arrangements have been made for the Windows Print Spooler Dialogue Box that informs
'Users that the print job is complete to be switched off, as multiple messages would
'be generated by this code.  A replacement message is therefore generated once the code
'has printed the document.
'An Icon will be placed on the Standard Toolbar to run this code.
'This code should be stored in Normal.dot to ensure that it is available to all documents.

'Version 1.3

'? Adam Cosby Sep 2007
'************************************


'********** Declare Constants and Variables **********
' On Error keep going
On Error Resume Next

'Variable to hold the name of the tray containing Letter Head paper
Dim LetterHeadTray As Integer

'Variable to hold the message to be displayed in Message Boxes
Dim Message As String

'Variable to hold the name of the tray containing Plain paper
Dim PlainTray As Integer

'Variable to hold the Style of Message Boxes
Dim Style

'Variable to hold the Title of Message Boxes
Dim Title As String

'Variable to hold the number of pages in the document
Dim TotalPages As Integer

'Variable to hold the location of the active printer
Dim PrinterLocation As String

'Variable to hold the name of the active printer
Dim PrinterName As String

'Variable to receive the user response from Message Boxes
Dim Response

'*****************************************************

'********** Main Code **********
'Determine the Active Printer
PrinterName = LCase(PrinterToPrintTo)
'PrinterNameLength = Len(PrinterName) - 9
'PrinterName = Left(PrinterName, PrinterNameLength)
'Determine the number of pages to be printed
ActiveDocument.Repaginate
TotalPages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)

'Set the names of the paper trays and the location for the Active Printer
If PrinterName = LCase("\\jonesterm\HP LaserJet 4250DTN PCL 6 (New Office)") Then
    LetterHeadTray = " Tray 2"
    PlainTray = " Tray 3"
    PrinterLocation = "New Office"
    Else
    If PrinterName = LCase("\\jonesprint\HP 4200TN PCL 6 (2nd Floor)") Then
        LetterHeadTray = 260
        PlainTray = 257
        PrinterLocation = "New Office"
        Else
        If PrinterName = LCase("\\jonesprint\HP 4050 PCL6 (Ground Floor)") Then
            LetterHeadTray = 260
            PlainTray = 259
            PrinterLocation = "HHG OFFICE"
            Else
            If PrinterName = LCase("\\jonesprint\HP 4200TN PCL 6 2nd Floor (Big Office)") Then
                LetterHeadTray = "Tray 3"
                PlainTray = "Tray 2"
                PrinterLocation = ""
                Else
                If PrinterName = LCase("\\jonesdata\SHARP MX-2700N PCL6") Then
                    LetterHeadTray = "Tray 3"
                    PlainTray = "Tray 2"
                    PrinterLocation = ""
                    Else
                    If PrinterName = LCase("\\jonesdata\SHARP AR-M351N PCL6") Then
                        LetterHeadTray = 259
                        PlainTray = 257
                        PrinterLocation = ""
                    End If
                End If
            End If
        End If
    End If
End If

'This displays the variables settings depending on the Active Printer
'!!!!It will be remarked out for the final code, as it may be useful for on site tests!!!!
'Message = "The Printer is " & PrinterName _
'            & Chr(13) _
'            & Chr(13) & "The Location is " & PrinterLocation _
'            & Chr(13) _
'            & Chr(13) & "The Letter Head Tray is " & LetterHeadTray _
'            & Chr(13) _
'            & Chr(13) & "The Plain Paper Tray is " & PlainTray
'Style = vbInformation
'Tile = "Printer Details"
'Response = MsgBox(Message, Style, Title)
'Exit Sub

'Send the first page to the printer's Letter Head Tray
With ActiveDocument.PageSetup
    .FirstPageTray = LetterHeadTray
    .OtherPagesTray = PlainTray
End With
   
Application.PrintOut _
    FileName:="", _
    Range:=wdPrintRangeOfPages, _
    Item:=wdPrintDocumentContent, _
    Copies:=1, _
    Pages:="1", _
    PageType:=wdPrintAllPages, _
    Collate:=False, _
    Background:=True, _
    PrintToFile:=False, _
    PrintZoomColumn:=0, _
    PrintZoomRow:=0, _
    PrintZoomPaperWidth:=0, _
    PrintZoomPaperHeight:=0

'Send any subsequent pages to the printer's Plain Paper Tray
If TotalPages > 1 Then
   
    With ActiveDocument.PageSetup
        .FirstPageTray = PlainTray
        .OtherPagesTray = PlainTray
    End With

    Application.PrintOut _
        FileName:="", _
        Range:=wdPrintRangeOfPages, _
        Item:=wdPrintDocumentContent, _
        Copies:=1, _
        Pages:="2-" & TotalPages, _
        PageType:=wdPrintAllPages, _
        Collate:=False, _
        Background:=True, _
        PrintToFile:=False, _
        PrintZoomColumn:=0, _
        PrintZoomRow:=0, _
        PrintZoomPaperWidth:=0, _
        PrintZoomPaperHeight:=0
End If

'Send a second copy of the document to the printer's Plain Paper Tray
   
With ActiveDocument.PageSetup
    .FirstPageTray = PlainTray
    .OtherPagesTray = PlainTray
End With
   
Application.PrintOut _
    FileName:="", _
    Range:=wdPrintRangeOfPages, _
    Item:=wdPrintDocumentContent, _
    Copies:=1, _
    Pages:="1-" & TotalPages, _
    PageType:=wdPrintAllPages, _
    Collate:=False, _
    Background:=True, _
    PrintToFile:=False, _
    PrintZoomColumn:=0, _
    PrintZoomRow:=0, _
    PrintZoomPaperWidth:=0, _
    PrintZoomPaperHeight:=0
   
'Display message to inform user that the print job has finished
'Message = "Your Print Job has been sent to: " & PrinterName _
'                & Chr(13) _
'                & Chr(13) & PrinterLocation
'Style = vbInformation
'Title = "Print Job Complete"
'Response = MsgBox(Message, Style, Title)

'Set back to tray three
With ActiveDocument.PageSetup
    .FirstPageTray = PlainTray
    .OtherPagesTray = PlainTray
End With

End Sub

---

Its really awkerward because different users use different printer which is why I made the LetterHeadRun they way I did.

The problem I have firstly is that when I am in word and click file>print>options and change default tray to tray 2 for example. It still prints to tray 3 so it completly ignores it which is why I had it changing the page setup as that is the only way it works.

I am getting a problem though where it will then remember the page setup (set to tray 2, (letterhead)), when they actually just want to print normally.

I need it where it will work on all machines and will not interfer with there default settings. I simply put two buttons on there menu which refers to printhp and printsharp so they have choice of two printer.

The other problem I have is that i recorded the macro (changing the page setup and such for the sharp printer) but when i then put the code into the macro it ignores it.

There was also a bit of a bizzare problem when when I click on sharp (printsharp) it would also print to the hp?? the other printer on there system.

I think i must have messed something up but I cannot see what. Hopefully they can be ironed out.

Thanks for you help
k0r54

I am bored today and this is similar to something I have worked on recently so I thought I'd have a play with it.

The code I've written chooses trays based on your currently-selected printer and puts your tray back to the original setting when it's finished. It looks up the tray names/numbers in the function GetTrayName, which you're going to have to keep up to date unfortunately.

Note, tray names and numbers sometimes change when printer drivers are updated.

Here's the code (I recommend you have 'Option Explicit' at the top of your module):

Main sub:
[vba]Public Sub PrintMain()

Dim lOriginalTray As Long
Dim lPages As Long
lPages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)

With Options

lOriginalTray = .DefaultTrayID

If ChangeTray("Letter") Then

Application.PrintOut _
FileName:="", _
Range:=wdPrintRangeOfPages, _
Item:=wdPrintDocumentContent, _
Copies:=1, _
Pages:="1", _
PageType:=wdPrintAllPages, _
Collate:=True, _
Background:=True, _
PrintToFile:=False

If lPages > 1 And ChangeTray("Plain") Then

Application.PrintOut _
FileName:="", _
Range:=wdPrintRangeOfPages, _
Item:=wdPrintDocumentContent, _
Copies:=1, _
Pages:="2-" & CStr(lPages), _
PageType:=wdPrintAllPages, _
Collate:=True, _
Background:=True, _
PrintToFile:=False

Else
MsgBox "Could not set Plain paper tray"
End If

Else
MsgBox "Could not set letter paper tray"
End If

.DefaultTrayID = lOriginalTray

End With

End Sub[/vba] ChangeTray function:
[vba]Private Function ChangeTray(TrayType As String) As Boolean

On Error GoTo Err_ChangeTray

Const lngIterations As Long = 5000
Dim lngTrayID As Long
Dim bSuccess As Boolean
Dim sTrayName As String

lngTrayID = 0
bSuccess = False
sTrayName = UCase(Trim(GetTrayName(TrayType)))

With Options
If IsNumeric(sTrayName) Then
' If TrayName is a number, just set tray to that
.DefaultTrayID = CLng(sTrayName)
bSuccess = True
Else
' Loop through the first lngIterations possible tray options until
' we find one matching TrayName
Do While lngTrayID <= lngIterations And _
InStr(1, UCase(.DefaultTray), sTrayName, vbTextCompare) = 0
lngTrayID = lngTrayID + 1
.DefaultTrayID = lngTrayID
Loop
If UCase(Trim(.DefaultTray)) = sTrayName Then bSuccess = True
End If
End With

Exit_ChangeTray:

ChangeTray = bSuccess
Exit Function

Err_ChangeTray:

bSuccess = False
Resume Exit_ChangeTray

End Function[/vba] GetTrayName function:
[vba]Private Function GetTrayName(TrayType As String) As String

Dim sPrinterName As String
Dim sLetterTray As String
Dim sPlainTray As String

sPrinterName = UCase(Application.ActivePrinter)

Select Case sPrinterName
Case "\\JONESTERM\HP LASERJET 4250DTN PCL 6 (NEW OFFICE)"
sLetterTray = " Tray 2"
sPlainTray = " Tray 3"
Case "\\JONESPRINT\HP 4200TN PCL 6 (2ND FLOOR)"
sLetterTray = "260"
sPlainTray = "257"
Case "\\JONESPRINT\HP 4050 PCL6 (GROUND FLOOR)"
sLetterTray = "260"
sPlainTray = "259"
Case "\\JONESPRINT\HP 4200TN PCL 6 2ND FLOOR (BIG OFFICE)"
sLetterTray = "Tray 3"
sPlainTray = "Tray 2"
Case "\\JONESDATA\SHARP MX-2700N PCL6"
sLetterTray = "Tray 3"
sPlainTray = "Tray 2"
Case "\\JONESDATA\SHARP AR-M351N PCL6"
sLetterTray = "259"
sPlainTray = "257"
Case Else
sLetterTray = ""
sPlainTray = ""
End Select

If UCase(TrayType) = "LETTER" Then
GetTrayName = sLetterTray
Else
GetTrayName = sPlainTray
End If

End Function[/vba]
Regards

I haven't looked closely at the code but fellow Word MVP, Jonathan West has written a series of articles on Controlling the Printer from Word VBA, which you might find interesting, particularly Part 1: Using VBA to Select the Paper Tray