Нашёл что-то похожее,но надо допиливать
[vba]Код
Sub discharge()
Dim objWord As Object
    Dim File_Name As String
    Dim FileSt As String
    Dim FileNew As String
    Dim MyLink As Object
    Set objWord = CreateObject("Word.Application")
    File_Name = Range("C2").Value
    FileSt = "D:\\Новая папка\\Шаблон.docx"
    FileNew = "D:\Новая папка\\" & File_Name & ".docx"
    objWord.Documents.Open FileSt
    For Each MyLink In objWord.ActiveDocument.Fields
        MyLink.Update
        MyLink.Unlink
    Next MyLink
    objWord.ActiveDocument.SaveAs _
            Filename:=FileNew, _
            FileFormat:=wdFormatDocument, _
            Password:="", _
            AddToRecentFiles:=True, _
            WritePassword:="", _
            ReadOnlyRecommended:=False
    objWord.Quit
End Sub
 [/vba]