Copy template word document and replace specific parts

[YasserKhalil]

Hello everyone
I have a word document named "Template" in the same path of thisworkbook.path
How can I copy this Template word document and name it with a cell value (say Z1 cell) then replace the string ##NAME## with cell A2?
I have this code but it works on an existing document

Code: Select all

Sub Test()
    Dim objWd       As Object
    Dim objDoc      As Object
    Dim strName     As String
    
    With Application.FileDialog(1)
        .Filters.Clear
        .Filters.Add "Word Documents", "*.doc*"
        .InitialFileName = ThisWorkbook.Path & "\*.doc*"
        If .Show Then
            strName = .SelectedItems(1)
        Else
            Beep
            Exit Sub
        End If
    End With
    
    On Error Resume Next
        Set objWd = GetObject(Class:="Word.Application")
        If objWd Is Nothing Then Set objWd = CreateObject(Class:="Word.Application")
    On Error GoTo 0
    objWd.Visible = True
    
    Set objDoc = objWd.Documents.Open(strName)
    
    With ThisWorkbook.Worksheets("INF")
        objDoc.Content.Find.Execute findText:="XXXXX", ReplaceWith:=.Range("B3").Value, MatchWholeWord:=False, Replace:=2
        objDoc.Content.Find.Execute findText:="YYYYY", ReplaceWith:=.Range("B5").Value, MatchWholeWord:=False, Replace:=2
    End With
    
    Rem objDoc.Close SaveChanges:=True
End Sub

How can I copy the Template word document first before proceeding to the replacement parts?

[HansV]

I'm not sure I fully understand what you want. Perhaps this?

Code: Select all

Sub Test()
    Dim objWd       As Object
    Dim objDoc      As Object
    Dim strName     As String
    
    On Error Resume Next
        Set objWd = GetObject(Class:="Word.Application")
        If objWd Is Nothing Then Set objWd = CreateObject(Class:="Word.Application")
    On Error GoTo 0
    objWd.Visible = True
    
    strName = ThisWorkbook.Path & "\" & Replace(Range("Z1").Value, "##NAME##", Range("A2").Value) & ".docx"
    FileCopy ThisWorkbook.Path & "\Template.docx", strName
    Set objDoc = objWd.Documents.Open(strName)
    
    With ThisWorkbook.Worksheets("INF")
        objDoc.Content.Find.Execute findText:="XXXXX", ReplaceWith:=.Range("B3").Value, MatchWholeWord:=False, Replace:=2
        objDoc.Content.Find.Execute findText:="YYYYY", ReplaceWith:=.Range("B5").Value, MatchWholeWord:=False, Replace:=2
    End With
    
    Rem objDoc.Close SaveChanges:=True
End Sub

[YasserKhalil]

Thank you very much my tutor ..
Is there a way to delete the second line of the word document if specific cell is empty?

[YasserKhalil]

Another point : the word application after running the code is still open. how can I completely close the word application?

[HansV]

Thank you very much my tutor ..
Is there a way to delete the second line of the word document if specific cell is empty?

Is that a paragraph, or a line within a paragraph?

[HansV]

Another point : the word application after running the code is still open. how can I completely close the word application?

If you want to be prompted to save modified documents:

Code: Select all

    objWd.Quit SaveChanges:=-2

If you want to save modified documents automatically:

Code: Select all

    objWd.Quit SaveChanges:=True

If you want to close all documents without saving them:

Code: Select all

    objWd.Quit SaveChanges:=False

[YasserKhalil]

I am using this line

Code: Select all

objWd.Quit SaveChanges:=True

and it closes the word document and it is saved well but the word application isn't closed ..

As for the line is is a paragraph of one line

[YasserKhalil]

Sorry it seems I didn't pay attention to the method Quit and I have used Close. Now it is working well as for closing the application.

If I used Application.ScreenUpdating =False will this make the process faster or there any thing related to the word application itself regarding that point?

[HansV]

You can use

Code: Select all

    objWd.ScreenUpdating = False
    ...
    objWd.ScreenUpdating = True

Using Application.ScreenUpdating in an Excel macro will apply only to Excel, not to Word.

[HansV]

To delete the second paragraph, you can use

Code: Select all

    If Range("...").Value = "" Then
        objDoc.Paragraphs(2).Range.Delete
    End If

[YasserKhalil]

Thank you very much my tutor for great and awesome help.