Microsoft Office Forums - View Single Post - [Solved] I need to edit a macro to open *.Doc and *.Docx files

Rampum15 · 09-09-2022, 05:09 AM

Hi Paul,
Thanks for the reply, I wasn't sure how much detail to start with. Our macro is a simple one that opens a document, does a find and replace on three fields, prints it, and then closes it without saving. All I need is a way for the macro to open the file regardless if it has a *.doc or *.docx extension. We have over 3500 documents, and we print approximately 100 per day on average. I've pasted the entire macro below for reference.

Code:

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:="Z:\Travellers" & File & ".doc", _
            ConfirmConversions:=False, ReadOnly:=True, AddToRecentFiles:=False, _
            Revert:=False, Format:=wdOpenFormatAuto, XMLTransform:=""
        With ActiveDocument
            With Selection.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