[已解决]求帮忙修改一下提取word文档内包含指定关键词的语句代码

jian82372387

需求：将11月份汇总文件夹里所有WORD文件里带有主板故障类型的内容提取到excel中，第一列为word文件名称，第二列内容为含有指定关键词的语句。（现在下面代码只能提取到word的表格中，而且如果某个word文档中有多条含有关键词的语句只能提取到第一次出现的，后面的无法提取出来，而且能否将文件夹路径改为可以选择，不需要每次输入路径）有大神能帮忙修改一下吗？？？

Sub shishi()
Set FSO对象 = CreateObject("Scripting.FileSystemObject")
Set 文件夹 = FSO对象.GetFolder("c:\Users\Adminis\Desktop/11月份维修汇总")
行 = 1
For Each i In 文件夹.Files
    文件名 = FSO对象.GetBaseName(i)
    Set 文档 = Documents.Open(CStr(i))
    s = "(分)(*)(主板故障)"
    With 文档.Content.Find
        .Text = s
        .MatchWildcards = True  '使用通配符
        If .Execute Then a = Replace(Replace(.Parent, "分", ""), "主板故障", "")
    End With
    ThisDocument.Tables(1).Cell(行, 1).Range.Text = 文件名
    ThisDocument.Tables(1).Cell(行, 2).Range.Text = a
    行 = 行 + 1
    文档.Close
Next
End Sub

最佳答案

月排行榜 / 总排行榜

cutecpu

2021-12-26 02:03

祝順心，南無阿彌陀佛！

跳转到最佳答案楼层

cutecpu

祝順心，南無阿彌陀佛！

jian82372387

cutecpu 发表于 2021-12-26 02:03
祝順心，南無阿彌陀佛！

代码是这样吗？？好像上传后代码有些变乱码了
Sub demo()
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set fd = Application.FileDialog(msoFileDialogFolderPicker)
   If fd.Show = -1 Then Set folder = fso.GetFolder(fd.SelectedItems(1))
Set word = CreateObject("word.Application")
   [a2:b1000].ClearContents
   For Each file In folder.Files
      If Not file Like "*.docx" Then GoTo 1
      Name = fso.getbasename(file)
      Set doc = word.Documents.Open(file.Path)
      With doc
         For Each p In .Paragraphs
            If InStr(p.Range.Text, "�D狾珿毁") > 0 Then
               [a2].Offset(r).Resize(, 2) = Array(Name, p.Range.Text)
               r = r + 1
            End If
         Next
         .Close
      End With
1: Next
   word.Quit
End Sub

jian82372387

jian82372387 发表于 2021-12-26 09:20
代码是这样吗？？好像上传后代码有些变乱码了
Sub demo()
   Set fso = CreateObject("Scripting.FileS ...

改了测试了也不行

jian82372387

jian82372387 发表于 2021-12-26 13:35
改了测试了也不行

可以拉，感谢，我找到原因了，是因为有部分word文件名后缀是.doc，所以不成功