Sub Travellers()
    MsgBox ("IS FINEPRINT SET AS THE DEFAULT PRINTER?")
    fsDT = InputBox("Due Date is...", "Due Date", "DUE DATE")
    If File = "quit" Then Num = 1 Else Num = 0
    Do While Num = 0
        fsWON = InputBox("Enter Work Order Number or press Cancel to exit", "Work Order #", "Work Order Number")
        If fsWON = "" Then Exit Do
        File = InputBox("Name of the Part File to open?", "Open File", "Part Number")
        QTY = InputBox("Order Quantity is...", "Order Quantity", "Quantity")
        Documents.Open FileName:="S:\Word\Parts\" & File & ".doc", _
            ConfirmConversions:=False, ReadOnly:=True, AddToRecentFiles:=False, _
            Revert:=False, Format:=wdOpenFormatAuto, XMLTransform:=""
        With ActiveDocument
            With .Find
                .ClearFormatting
                .Replacement.ClearFormatting
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
                .Text = "WRKORD"
                .Replacement.Text = fsWON
                .Execute Replace:=wdReplaceAll
                .Text = "QTY"
                .Replacement.Text = QTY
                .Execute Replace:=wdReplaceAll
                .Text = "DDT"
                .Replacement.Text = fsDT
                .Execute Replace:=wdReplaceAll
            End With
            .PrintOut Background = True
            .Close SaveChanges:=wdDoNotSaveChanges
        End With
    Loop
End Sub