如何调整VBA代码以提取所有打开Word文档中的粗体文本实例

以下代码可以遍历所有已打开的Word文档，提取所有粗体文本后统一存入新建的Word文档：

Sub A__GrabTheBoldsFromAllOpenDocs()
On Error GoTo cleanUp
Application.ScreenUpdating = False
    Dim TargetDoc As Document
    Dim currentDoc As Document
    Dim r As Range
    
    ' 新建用于存储提取结果的文档
    Set TargetDoc = Documents.Add
    
    ' 遍历所有已打开的Word文档
    For Each currentDoc In Documents
        ' 跳过结果文档本身，防止重复提取
        If currentDoc <> TargetDoc Then
            Set r = currentDoc.Range
            With r
                With .Find
                    .Text = ""
                    .Format = True
                    .Font.Bold = True
                End With
                Do While .Find.Execute(Forward:=True) = True
                    If r.Bold Then
                        ' 保留原格式粘贴到结果文档末尾
                        TargetDoc.Range.Characters.Last.FormattedText = .FormattedText
                        TargetDoc.Range.InsertParagraphAfter
                        .Collapse 0
                    End If
                Loop
            End With
        End If
    Next currentDoc
    
cleanUp:
Application.ScreenUpdating = True
Set TargetDoc = Nothing
Set currentDoc = Nothing
End Sub

• 替换了原代码仅处理当前激活文档的逻辑，改为遍历所有已打开的Word文档对象
• 新增结果文档过滤逻辑，避免把新建的结果文档里的内容也纳入提取范围
• 完全保留原代码的格式保留、自动分段特性，提取的内容会按文档打开顺序排列，保留原有的粗体格式

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