Using Excel to Save a Word File With Name

Question

I have a Word template which I am using with < amount >, < account > etc. which I am then having a VBA script in Excel pull data from cells and replace the < amount > etc. with the value in the cell.

I've got it working fantastically now but I am having some troubles with saving the Word document. Essentially I am wanting to have the Excel script pull the name for the document from a cell and then save the document with that as its name in a different location as to not save over the template.

Essentially my goal is to fill data into a handful of cells and then trigger a VBA script which replaces text on the Word document template and then saves the document with a particular name.

I've attempted the answers from a similar question here Excel VBA to open word template, populate, then save as .docx file somewhere else but it isn't working within my code.

Here's the existing code so far:

Option Explicit

Public Sub WordFindAndReplace()
Dim ws As Worksheet, msWord As Object

Set ws = ActiveSheet
Set msWord = CreateObject("Word.Application")

With msWord
.Visible = True
.Documents.Open "/Users/Aafrika/Desktop/Test.docx"
.Activate

With .ActiveDocument.Content.Find
    .ClearFormatting
    .Replacement.ClearFormatting

    .Text = "<date>"
    .Replacement.Text = Format(ws.Range("C1").Value2, "dd/mm/yyyy")

    .Forward = True
    .Wrap = 1               'wdFindContinue (WdFindWrap Enumeration)
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False

    .Execute Replace:=2     'wdReplaceAll (WdReplace Enumeration)

    .Text = "<amount>"
    .Replacement.Text = Format(ws.Range("C2").Value2, "currency")

    .Forward = True
    .Wrap = 1               'wdFindContinue (WdFindWrap Enumeration)
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False

    .Execute Replace:=2     'wdReplaceAll (WdReplace Enumeration)


End With
.Quit SaveChanges:=True
End With
End Sub

Any ideas on how to get this to work would be great. Thanks in advance!

`.Quit SaveChanges:=True` You are overwriting the main document. You have to use `.SaveAs`. Record a macro in Word and you will get the code for `.SaveAs` — Siddharth Rout, Aug 24 '19 at 04:41
@SiddharthRout I did try this, but it saves the Excel document, not the Word document — numpty, Aug 24 '19 at 04:42
Declare a word document object and work with that. `Dim oDoc As Object: Set oDoc = msWord.Documents.Open("/Users/Aafrika/Desktop/Test.docx")` and then use `oDoc.SaveAs` — Siddharth Rout, Aug 24 '19 at 04:48
I have posted an example. You may have to refresh the page to see it — Siddharth Rout, Aug 24 '19 at 04:57

score 3 · Accepted Answer · answered Aug 24 '19 at 04:57

3

Work with objects. it will make your life very easy. You are saving and closing the original document. See this example. This creates relevant objects and then works with it.

Is this what you are trying? (untested)

Option Explicit

Private Sub WordFindAndReplace()
    Dim ws As Worksheet
    Set ws = ActiveSheet

    Dim msWord As Object
    Dim msWordDoc As Object
    Set msWord = CreateObject("Word.Application")

    msWord.Visible = True
    Set msWordDoc = msWord.Documents.Open("/Users/Aafrika/Desktop/Test.docx")

    With msWordDoc
        With .Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting

            .Text = "<date>"
            .Replacement.Text = Format(ws.Range("C1").Value2, "dd/mm/yyyy")

            .Forward = True
            .Wrap = 1               'wdFindContinue (WdFindWrap Enumeration)
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False

            .Execute Replace:=2     'wdReplaceAll (WdReplace Enumeration)

            .Text = "<amount>"
            .Replacement.Text = Format(ws.Range("C2").Value2, "currency")

            .Forward = True
            .Wrap = 1               'wdFindContinue (WdFindWrap Enumeration)
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False

            .Execute Replace:=2     'wdReplaceAll (WdReplace Enumeration)
        End With
        .SaveAs Filename:="Some File Name", FileFormat:=12 'wdFormatXMLDocument
        DoEvents
        .Close (False)
    End With

    msWord.Quit
End Sub

answered Aug 24 '19 at 04:57

Siddharth Rout

147,039
17
206
250

Hmm, it seems very promising but I'm now getting the popup "Office is still updating linked or embedded objects for this workbook." and the file isn't getting created. – numpty Aug 24 '19 at 05:05
`.SaveAs Filename:="Some File Name", FileFormat:=12 'wdFormatXMLDocument` What did you type in `"Some File Name"` – Siddharth Rout Aug 24 '19 at 05:07
`"Office is still updating linked or embedded objects for this workbook."` That is an Excel message. Seems like you have some embedded objects in Excel. – Siddharth Rout Aug 24 '19 at 05:08
I tried it just with "output" to no avail. What would you suggest to fix that error, I am not too familiar with all this so I apologise. – numpty Aug 24 '19 at 05:10
you need to give a compelete path. for example `.SaveAs Filename:="C:\Temp\MyFile.Docx"` – Siddharth Rout Aug 24 '19 at 05:13
Okay awesome, got it saving with that name now - how would you go about saving it in a location with the name pulled from Cell C3? Also, I've noticed if Word is already open (not in the target file but in general) I get the error Run-time error '-2146959355 (80080005)' on the line Set msWord = CreateObject("Word.Application") – numpty Aug 24 '19 at 05:17
if word is already open then use `GetObject(, "Word.Application")` You need to use error handling (but then that becomes another question) To save from a cell say c3 if C3 has "C:\Temp\MyFile.Docx" use this `.SaveAs Filename:=ws.Range("C3").Value2` – Siddharth Rout Aug 24 '19 at 05:20
Ah, I was more meaning I want the name of the file to be what is in C3 for example, if C3 contains 'hello' then I want it to save the file as "C:\Temp\hello.Docx" - if that makes sense? – numpty Aug 24 '19 at 05:25
Oh and for error handling, are you meaning something like On Error Goto [Label] else run something different? – numpty Aug 24 '19 at 05:28
`.SaveAs Filename:="C:\Temp\" & ws.Range("C3").Value2 & ".Docx"` – Siddharth Rout Aug 24 '19 at 05:28
For error handling i meant using GetObject and CreateObject one after the other within `On Error Resume Next` – Siddharth Rout Aug 24 '19 at 05:29
You're brilliant! How would I go about the latter part of the question regarding the password, or is that a no go? – numpty Aug 24 '19 at 05:29
Any aditional query, simply ask a new question :) Ensure you show what have you tried though in that quesiton :) – Siddharth Rout Aug 24 '19 at 05:30
1

I figured the password bit out! You've got me excited to delve more into this stuff, thank-you @Siddharth – numpty Aug 24 '19 at 05:36
@Tane Since the password element was part of the original question, could you edit your question or the answer to make sure that someone who finds this question in the future can find all the relevant information? – DecimalTurn Aug 24 '19 at 07:08

Using Excel to Save a Word File With Name

1 Answers1