Excel VBA - 带有 462 错误的 Word.Selection 问题

Question

我正在创建一个 Excel vba 来搜索 word 文档中的关键字，然后返回上面的行。代码如下：

Sub TEST()

Dim s As Word.Selection
fileaddress = "C:\XXXXXX"

Set appWrd = New Word.Application
Set docWrd = appWrd.Documents.Open(fileaddress)
Set aRange = docWrd.Range

Do
    aRange.Find.Text = "keyword"
    aRange.Find.Execute Forward:=True
    If aRange.Find.Found Then
        aRange.Select
        Set s = Word.Selection
        s.MoveUp Unit:=wdLine, COUNT:=1
        MsgBox s.Paragraphs(1).Range.ListFormat.ListString
        Set s = Nothing
    End If
Loop While aRange.Find.Found

docWrd.Close
appWrd.Quit

End Sub

代码第一次运行良好，第二次出现 462 错误。我想问题可能出在这个 Word.Selection 上。有什么想法吗？

PS：word文件是这样的：

1. 标题样式1

关键字

1.1 标题样式2

关键字

因此代码搜索关键字，然后将光标从关键字位置向上移动一行，然后 msgbox 将返回“1”和“1.1”。但是，正如我所说，代码第一次运行良好。我认为这与上次运行 excel 后任务管理器中没有杀死某些进程有关。

已解决

新代码：

Sub TEST()

Dim s As Word.Selection
fileaddress = "C:\XXXXXX"

Set appWrd = New Word.Application
Set docWrd = appWrd.Documents.Open(fileaddress)
Set aRange = docWrd.Range

Do
    aRange.Find.Text = "keyword"
    aRange.Find.Execute Forward:=True
    If aRange.Find.Found Then
        aRange.Select
        Set s = appWrd.Selection   '<------- This is the only change!
        s.MoveUp Unit:=wdLine, COUNT:=1
        MsgBox s.Paragraphs(1).Range.ListFormat.ListString
        Set s = Nothing
    End If
Loop While aRange.Find.Found

docWrd.Close
appWrd.Quit

End Sub

Answer 1

换行

Set s = Word.Selection

与

Set s = appWrd.Selection

“Word”对象在被杀死后不喜欢被重用（即使它被重新创建）。

Answer 2

当您提到“上面的行”时，我尝试检查该单词是否在表格中或句子中。所以我将文档中的单词与关键字进行比较，然后阅读表格中的上一行或它所属的句子，然后倒数直到找到上一个句子。

Sub TEST_Line(fileaddress As String, Keyword As String)
   Set appWrd = CreateObject("Word.Application")
   Set docWrd = appWrd.Documents.Open(fileaddress)
   Set DWords = docWrd.Words
   For Counter = 1 To DWords.Count
      If UCase(Keyword) Like UCase(DWords.Item(Counter)) Then
         If DWords.Item(Counter).Tables.Count > 0 Then
            Row_Ref = DWords.Item(Counter).Rows(1).Index - 1
            Col_Ref = DWords.Item(Counter).Columns(1).Index
            If Row_Ref > 0 Then
               MsgBox DWords.Item(Counter).Tables(1).Columns(Col_Ref).Cells(Row_Ref).Range.Text
            End If
         Else
            aRange = DWords.Item(Counter).Sentences(1)
            Reverse_Counter = Counter - 1
            If Reverse_Counter < 1 Then
               'MsgBox "First Sentence"
            Else
               Do While DWords.Item(Reverse_Counter).Sentences(1) = DWords.Item(Counter).Sentences(1)
               Reverse_Counter = Reverse_Counter - 1
               Loop
               MsgBox DWords.Item(Reverse_Counter).Sentences(1)
            End If
         End If
      End If
   Next Counter
   docWrd.Close
   appWrd.Quit
End Sub