Проблема с использованием Loop для поиска слов в Word Doc VBA

Question

У меня есть динамический список поисковых слов в столбце.Я хочу открыть документ Word, а затем вытянуть обратно все найденные слова.По какой-то причине после того, как он находит свое первое совпадение, он продолжает проходить через код и больше не откатывает совпадения.Он должен был отозвать 6 слов, но он отозвал только первое слово в моем динамическом списке.Какие-либо предложения?Вот мой код:

Sub SearchWord()
Dim odoc As Document
Dim path As String
Dim rng As Word.Range
path = "*MYFILEPATH*"

Dim DS As Worksheet
Dim SS As Worksheet
Set DS = Sheets("Report")
Set SS = Sheets("Search Index")

    With SS
        SSlastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
    End With

    With DS
        dslastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With


Set odoc = Documents.Open(Filename:=path)
Set rng = odoc.Content


For J = 2 To SSlastRow
    sText = SS.Range("B" & J).Value

    With rng.Find
        .MatchCase = False
        .Text = sText
    End With
    rng.Find.Execute
    If rng.Find.found = True Then
        DS.Range("Q" & 2).Value = DS.Range("Q" & 2).Value & sText & ";" & " "
    Else
        DS.Range("Q" & 2).Value = DS.Range("Q" & 2).Value
    End If
Next J

odoc.Close wdDoNotSaveChanges
End Sub

Answer 1

Проблема в том, где вы устанавливаете свой rng - что вам не нужно.Ваш код может быть упрощен и другими способами.Попробуйте:

Sub SearchWord()
Dim oDoc As Word.Document
Dim path As String
path = "*MYFILEPATH*"

Dim DS As Worksheet, SS As Worksheet
Dim SSlastRow As Long, DSlastRow As Long, J As Long
Set DS = Sheets("Report")
Set SS = Sheets("Search Index")

SSlastRow = SS.Cells(SS.Rows.Count, "B").End(xlUp).Row
DSlastRow = DS.Cells(DS.Rows.Count, "A").End(xlUp).Row

Set oDoc = Documents.Open(FileName:=path, AddToRecentFiles:=False)

For J = 2 To SSlastRow
    sText = SS.Range("B" & J).Value
    With oDoc.Range.Find
        .MatchCase = False
        .Text = sText
        .Execute
        If .Found = True Then DS.Range("Q" & 2).Value = DS.Range("Q" & 2).Value & sText & "; "
    End With
Next J

oDoc.Close False
End Sub