Excel vba对Word内容进行替换

我想用excel环境下使用vba对word文档替换，代码没报错，但是没有替换成功，请各位帮忙看看

Sub 读取数据写入Word文件()
    Dim Word对象
    Dim 当前路径, 导出文件名, 导出路径文件名, i
    
    With Application '禁止弹询问提示
        .DisplayAlerts = Flag
        .EnableEvents = Flag
        .ScreenUpdating = Flag
        .Calculation = IIf(Flag = True, xlAutomatic, xlManual)
    End With
    
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    Set Word对象 = CreateObject("Word.Application") '//创建word文档，为操作document打开做准备
    showFolder = False
    
    fDialog.AllowMultiSelect = False '禁止多选
    fDialog.Title = "请选择勘测定界表" '弹窗选择文件
    fDialog.Filters.Add "Word文件", "*.docx;*.doc", 1
    
    If fDialog.Show = True Then '判断是否选择了文件
        For Each vrtSelectedItem In fDialog.SelectedItems
            a = Left(vrtSelectedItem, Len(vrtSelectedItem) - InStr(StrReverse(vrtSelectedItem), "\"))
            当前路径 = vrtSelectedItem
        Next
        
        With Word对象
            .Documents.Open 当前路径
            .Visible = False
            For i = 3 To 16 '填写表格数据
                .ActiveDocument.Tables(1).Cell(9, i).Range = Sheets("汇总辅助表").Cells(3, i - 1)
                .ActiveDocument.Tables(1).Cell(10, i).Range = Sheets("汇总辅助表").Cells(4, i - 1)
            Next i
            
            .Selection.Find.Clearformatting
            .ActiveDocument.Tables(1).Cell(11, 3).Range = Sheets("汇总辅助表").Cells(5, 2) '查找替换日期
            .ActiveDocument.Range.Select
            .Selection.Find.Text = "2022年*月*日"
            .Selection.Find.Replacement.Text = Format(Date, "yyyy年m月d日")
            .Selection.Find.Execute Replace:=wdReplaceAll
            
        End With
        Word对象.Selection.Find.Execute Replace:=wdReplaceAll
        Word对象.Documents.Save
        Word对象.Quit
        Set Word对象 = Nothing
        
        MsgBox "写入完成", 0, "成功"
    End If
End Sub

附件在这里，链接：https://pan.baidu.com/s/1dpiJftdyNW28tSFilt1_EA
提取码：ux23