求一段能批量提取word文档特定字体文本的代码

zl1st

各位大侠：
       近日收集了一批Word文件，文件名都是网络上自动生成的。毫无规律。但文件有一个共同的特点，就是里面都有方正小标宋简体做的真正标题，但字号、颜色可能各异，有的还分成了几行。各位坛友能否提供一段代码，批量读取word文件，将原文件名放在A列，方正小标宋简体无论几行都汇集到B列，那样我就可以把文件重命名成易懂的名称了。
       压缩包提供了测试文件和希望的结果。
       谢谢！

小花鹿

Sub MyFind()
    Dim s As String
    With ActiveDocument.Content
        With .Find
            .Font.Name = "方正小标宋简体"
            Do While .Execute
                s = s & .Parent.Text
            Loop
        End With
    End With
End Sub
再套个打开文件的循环

zl1st

小花鹿 发表于 2024-3-22 00:08
Sub MyFind()
    Dim s As String
    With ActiveDocument.Content

谢谢大侠，做了个目录循环，批处理部分文件成功。又发现一个问题，部分文件设置了加密、只能打开查看，禁止编辑，造成读取失败。我能够把这些文件批量转成PDF,请问能否实现VBA读取PDF文档特定字体文字功能?