Excel批量替换修改同径文件夹Word文件（一）

Private Sub CommandButton1_Click() '修改   
    Dim appWD, doc As Object, arr, i%, j%, M%, ran
    Set appWD = CreateObject("Word.Application")
    arr = [B1].CurrentRegion
    For i = 2 To UBound(arr)
        Set doc = appWD.Documents.Open(ThisWorkbook.Path & "\" & arr(i, 2))
        appWD.Visible = 0
        'appWD.Selection.HomeKey unit:=6
         appWD.ActiveDocument.Tables(1).Cell(12, 2).Range.Text = arr(i, 3)
        appWD.ActiveDocument.Tables(1).Cell(12, 4).Range.Text = arr(i, 4)
        appWD.ActiveDocument.Tables(1).Cell(15, 2).Range.Text = arr(i, 5)
      With doc.Content.Find
    .Text = "最低生活保障（   元/月）"
    .Forward = True
    .Execute
    'MsgBox .Found
    .Execute FindText:="最低生活保障（   元/月）", ReplaceWith:="最低生活保障（" & arr(i, 6) & "元/月）", _
        Format:=True, Replace:=wdReplaceAll
End With 

       doc.Save 
    Next
    appWD.Quit

End Sub