vba遍历多个文档的关键字所在段落写入EXCEL，提示类型未定义

z121213

大神帮我看看问题出在哪？应该怎么修改？以下为代码----
Sub ExtractParagraphsFromDocuments()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") ' 修改为你的工作表名称
    Dim keyword As String
    keyword = "关键字" ' 修改为你要查找的关键字
    Dim docPath As String
    Dim doc As Document
    Dim para As Paragraph
    Dim iRow As Long
    iRow = 1 ' 从第一行开始写入

    Dim fileDialog As FileDialog
    Set fileDialog = Application.FileDialog(msoFileDialogFilePicker)
    fileDialog.AllowMultiSelect = True ' 允许选择多个文件
    fileDialog.Title = "选择Word文档"
    If fileDialog.Show = -1 Then ' 如果选择了文件
        Dim file As Variant
        For Each file In fileDialog.SelectedItems
            Set doc = Documents.Open(file)
            ws.Cells(iRow, 1).Value = doc.Name ' 写入文档名
            ws.Cells(iRow, 2).Value = "无法确定" ' 暂时写入"无法确定"，可以根据需要修改
            ' 遍历文档中的所有段落
            For Each para In doc.Paragraphs
                If InStr(para.Range.Text, keyword) > 0 Then
                    ' 如果找到关键字，写入当前行的段落编号
                    ws.Cells(iRow, 2).Value = para.Range.Paragraphs(1).Range.ListFormat.ListValue.ListLevelNumber
                    Exit For ' 找到后退出循环
                End If
            Next para
            iRow = iRow + 1
            doc.Close False ' 关闭文档，不保存更改
        Next file
    End If
End Sub

fzxba

工具  引用

microsoft word  xx.x  object library

taller

如果使用前期绑定，需要：打开 VBE（快捷键 ALT+F11），在 VBE 中单击【工具】，选择【引用】，在【引用 VBAProject】对话框中选择 【Microsoft Word x Object Library】（根据你的 Office 版本选择）

前期绑定与后期绑定的区别

_微软在线文档:_

> [早期绑定和后期绑定 (Visual Basic)](https://learn.microsoft.com/zh-c ... c_id=M365-MVP-33461)

z121213

fzxba 发表于 2024-3-20 08:59
工具  引用

microsoft word  xx.x  object library

大神你真的是言简意赅，如果没有3楼的解释，小白我真心没看懂。但是又有新的问题了，能帮忙再看一下吗？

z121213

taller 发表于 2024-3-20 11:25
如果使用前期绑定，需要：打开 VBE（快捷键 ALT+F11），在 VBE 中单击【工具】，选择【引用】，在【引用 VB ...

感谢T版，耐心解答后类型未定义问题已解决。但是还有错误提示。。。

fzxba

z121213 发表于 2024-3-20 17:51
大神你真的是言简意赅，如果没有3楼的解释，小白我真心没看懂。但是又有新的问题了，能帮忙再看一下吗？: ...

抓住T版不放。于我而言，不属东不属西，也不属北，实属南……

z121213

fzxba 发表于 2024-3-20 18:08
抓住T版不放。于我而言，不属东不属西，也不属北，实属南……

我南，你不南

taller

z121213

换个思路，需求已实现，分享给大家。唯一不足就是路径中不能有中文...
Sub ExtractParagraphsWithKeyword()
    Dim fso As Object
    Dim folder As Object
    Dim file As Object
    Dim docApp As Word.Application
    Dim doc As Word.Document
    Dim para As Word.Paragraph
    Dim keyword As String
    Dim ws As Worksheet
    Dim i As Integer
    Dim j As Integer
    Dim filename As String
    Dim foundParagraphs As Integer

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder("C:\Documents\") ' 修改为包含文档的文件夹路径特别注意路径不能有中文
    Set ws = ThisWorkbook.Sheets("Sheet1") ' 修改为输出结果的工作表名称
    Set docApp = New Word.Application
    docApp.Visible = False
   
    keyword = "关键字" ' 修改为需要搜索的关键字
    i = 1 ' 输出到Excel的起始行
    foundParagraphs = 0
   
    For Each file In folder.Files
        If LCase(fso.GetExtensionName(file.Name)) = "doc" Or LCase(fso.GetExtensionName(file.Name)) = "docx" Then
            Set doc = docApp.Documents.Open(file.Path)
            filename = file.Name ' 文件名
            
            For Each para In doc.Paragraphs
                If InStr(1, para.Range.Text, keyword, vbTextCompare) > 0 Then
                    ws.Cells(i, 1).Value = filename ' 输出文件名
                    ws.Cells(i, 2).Value = para.Range.Text ' 输出段落文本
                    i = i + 1
                    foundParagraphs = foundParagraphs + 1
                End If
            Next para
            doc.Close
        End If
    Next file
   
    ws.Cells(1, 3).Value = "Found Paragraphs: " & foundParagraphs
    docApp.Quit
    Set docApp = Nothing
    Set fso = Nothing
End Sub

z121213

taller 发表于 2024-3-20 23:06

多谢T版，已解决