根据要求替换一个目录下所有文档的内容（VBA）

以下代码是excel VBA代码，复制到VBE编辑器中直接可以用，但是还有个问题未解决（以下标准红字），如果有大佬能帮解决实在感激不尽。

Sub tihuan()
Dim searchContent As String, ReplaceContent As String
myMode& = Val(InputBox("Search Mode:-3 To 3", "Find File", 0)) '指定Dos Dir的查找开关、返回模式
    '奇数为不含子文件夹、偶数为含子文件夹 / 负数为目录、正数为文档 / >1为文档及目录
    
    If myMode > -3 Then
        myFile$ = InputBox("Part of Filename or Filetype as "".""", "Find File", ".")
        '输入指定关键字，可以是文件(文档和目录)名称中的任意部分，或指定文件类型如 ".xl"
    
        Set myFolder = CreateObject("Shell.Application").BrowseForFolder(0, "GetFolder", 0)
        If Not myFolder Is Nothing Then myPath$ = myFolder.Items.Item.path Else MsgBox "Folder not Selected": Exit Sub
        '浏览列表指定查找目录
    End If
    tms = Timer
    With CreateObject("Wscript.Shell") 'VBA调用Dos命令
    cmdStr = Choose(myMode + 4, "/? ", "/a:d /b /s ", "/a:d /b ", "/a:a /b /s ", "/a:a /b ", "/b /s ", "/b ", "/a:a /o:e /o:n /s ", "/a:a /o:e /o:n ", "/a:d /o:e /o:n /s ", "/a:d /o:e /o:n ")
        ar = Split(.exec("cmd /c dir " & cmdStr & Chr(34) & myPath & Chr(34)).StdOut.ReadAll, vbCrLf)
        '指定Dos中Dir命令的开关然后提取结果 为指定文件夹以及所含子文件夹内的所有文件的含路径全名。
        
        s = UBound(ar) & " Files by Search time: " & Format(Timer - tms, " 0.00s") & " in: " & myPath
        Application.StatusBar = " Find " & s: tms = Timer '记录Dos中执行Dir命令的耗时 并在Excel状态栏上显示
        If myFile <> "" Then '如指定了匹配关键字则
            ar = Filter(ar, myFile) '按指定关键词myFile进行筛选。可筛选文件名或文件类型、然后在Excel状态栏上显示结果
            Application.StatusBar = Format(Timer - tms, "0.00s") & " Find " & 1 + UBound(ar) & " Files from " & s
        End If
    End With
    [a:a] = "": If UBound(ar) > -1 Then [a2].Resize(1 + UBound(ar)) = WorksheetFunction.Transpose(ar)
'    清空A列，然后输出结果
searchContent = InputBox("亲爱的，请输入要搜索的名称")
ReplaceContent = InputBox("亲爱的，请输入需要替换的词语")
'遍历excelA列所有内容，并将其赋值给需要替换的文档，循环打开文档进行替换，这里excel替换完成后电脑打不开不知道什么原因（我将其暂时注释掉），但是发送给手机能打开并且内容也是替换了的，希望有大佬能给个解释？？？
Dim rng As Range
For Each rng In Range("A:A")
        If InStr(rng, ".docx") > 0 Or InStr(rng, ".doc") > 0 Then
            ' 处理Word文档
            ReplaceContentInWordDocument rng, searchContent, ReplaceContent
'        ElseIf InStr(rng, ".xlsx") > 0 Or InStr(rng, ".xls") > 0 Then
'            ' 处理Excel文档
'            ReplaceContentInExcelDocument rng, searchContent, ReplaceContent
        End If
        Next rng
        Cells.Clear
         MsgBox "亲爱的，已经按照您的要求全部替换完毕！！"
End Sub

Sub ReplaceContentInWordDocument(filePath As Variant, searchContent As String, ReplaceContent As String)
    Dim document As Object
    
    On Error Resume Next
    ' 打开Word文档
    Set document = GetObject(filePath)
    On Error GoTo 0
   
    If Not document Is Nothing Then
        ' 替换文档内容
        With document.Content.Find
            .ClearFormatting
            .Text = searchContent
            .Replacement.Text = ReplaceContent
            .Execute Replace:=2 ' wdReplaceAll
        End With
        
        ' 保存并关闭文档
        document.Save
        document.Close
    End If
End Sub

'Sub ReplaceContentInExcelDocument(filePath As Variant, searchContent As String, ReplaceContent As String)
'    Dim Workbook As Object
'    Dim Worksheet As Object
'    Dim cell As Object
'
'    On Error Resume Next
'    ' 打开Excel工作簿
'    Set Workbook = GetObject(filePath)
'    On Error GoTo 0
'
'    If Not Workbook Is Nothing Then
'        ' 循环所有工作表
'        For Each Worksheet In Workbook.Sheets
'            ' 循环所有单元格
'            For Each cell In Worksheet.UsedRange
'                ' 检查单元格内容是否包含搜索内容
'                If InStr(1, cell.value, searchContent) > 0 Then
'                    ' 替换单元格内容
'                    cell.value = Replace(cell.value, searchContent, ReplaceContent)
'                End If
'            Next cell
'        Next Worksheet
'
'        ' 保存并关闭工作簿
'        Workbook.Save
'        Workbook.Close
'    End If
'End Sub

注意此代码需要所有源目录关闭的情况下进行，否则会出现不会替换的BUG