Word VBA替换加粗文本代码未生效，如何实现「HEADING:原文本」替换？

我有一段可正常从Word文件提取文本的VBA脚本，现在需要修改脚本，将文件中所有加粗文本替换为「HEADING:原文本」格式。修改后的脚本运行无报错，但生成的TXT文件中替换未生效。

原有工作脚本：

Sub GetTextFromWord()
    Dim fso As FileSystemObject
    Dim oWd As Object, oDoc As Object
    Const wdFormatText as Long = 2, wdCRLF as Long = 0

    Set fso = New FileSystemObject
    Set oWd = CreateObject("word.application")

    Set oDoc = oWd.Documents.Open("C:\temp\PDFs\New folder\Test")

    Dim filePath As String: filePath = "C:\temp\PDFs\New folder\Test" & "TEST" & ".txt"  'filename
    Debug.Print filePath
    
    oDoc.SaveAs2 fileName:=filePath, _
        FileFormat:=wdFormatText, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False, Encoding:=1252, InsertLineBreaks:=False _
        , AllowSubstitutions:=True, LineEnding:=wdCRLF, CompatibilityMode:=0
        
    oDoc.Close False
    oWd.Quit
End Sub

修改后的尝试脚本（替换未生效）：

Sub GetTextFromWord()
    Dim fso As FileSystemObject
    Dim oWd As Object, oDoc As Object
    Const wdFormatText As Long = 2, wdCRLF As Long = 0

    Set fso = New FileSystemObject
    Set oWd = CreateObject("word.application")

    Set oDoc = oWd.Documents.Open("C:\temp\PDFs\New folder\Test")

    Dim filePath As String: filePath = "C:\temp\PDFs\New folder\" & "TEST" & ".txt"  'filename
    Debug.Print filePath
    
    With oDoc.Content.Find
 .ClearFormatting
 .Font.Bold = True
 .Execute FindText:="", ReplaceWith:="HEADER: ^&", _
 Format:=True, Replace:=wdReplaceAll
End With
    
    oDoc.SaveAs2 Filename:=filePath, _
        FileFormat:=wdFormatText, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False, Encoding:=1252, InsertLineBreaks:=False _
        , AllowSubstitutions:=True, LineEnding:=wdCRLF, CompatibilityMode:=0
        
    oDoc.Close False
    oWd.Quit
End Sub

替换未生效的核心原因有三个：

1. 未定义wdReplaceAll常量：使用后期绑定（CreateObject("word.application")）时，VBA无法识别Word内置常量，必须手动定义。
2. 未清除替换目标的格式：默认情况下替换操作可能保留原文本的加粗格式，导致替换逻辑失效或效果不符合预期。
3. Word文件路径缺失扩展名：打开文件时未指定完整文件名（如.docx/.doc），可能导致无法正确打开目标文件。

修正后的完整脚本：

Sub GetTextFromWord()
    Dim fso As FileSystemObject
    Dim oWd As Object, oDoc As Object
    ' 手动定义Word常量（后期绑定必需）
    Const wdFormatText As Long = 2, wdCRLF As Long = 0
    Const wdReplaceAll As Long = 2

    Set fso = New FileSystemObject
    Set oWd = CreateObject("word.application")
    ' 可选：调试时设置Word可见，方便观察操作过程
    ' oWd.Visible = True

    ' 补充Word文件扩展名，确保打开目标文件
    Set oDoc = oWd.Documents.Open("C:\temp\PDFs\New folder\Test.docx")

    Dim filePath As String: filePath = "C:\temp\PDFs\New folder\TEST.txt"
    Debug.Print filePath
    
    With oDoc.Content.Find
        .ClearFormatting
        .Font.Bold = True ' 指定查找加粗格式的文本
        .Replacement.ClearFormatting ' 清除替换内容的格式，避免保留原加粗属性
        .Execute FindText:="", ReplaceWith:="HEADING: ^&", _
                 Format:=True, Replace:=wdReplaceAll
    End With
    
    oDoc.SaveAs2 Filename:=filePath, _
        FileFormat:=wdFormatText, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False, Encoding:=1252, InsertLineBreaks:=False _
        , AllowSubstitutions:=True, LineEnding:=wdCRLF, CompatibilityMode:=0
        
    oDoc.Close False
    oWd.Quit
    ' 释放对象，避免内存泄漏
    Set oDoc = Nothing
    Set oWd = Nothing
    Set fso = Nothing
End Sub

• 添加Const wdReplaceAll As Long = 2：后期绑定模式下必须手动定义该常量，否则VBA会默认将wdReplaceAll视为0（即wdReplaceNone），导致替换操作完全不执行。
• 增加.Replacement.ClearFormatting：确保替换后的文本不再保留原加粗格式，同时避免格式冲突导致替换逻辑失效。
• 补充Word文件扩展名：明确指定打开的文件类型，避免因路径模糊导致操作对象错误。
• 可选添加oWd.Visible = True：调试阶段开启后可直观看到Word中的替换效果，方便排查问题。

内容的提问来源于stack exchange，提问作者Nick