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