VBA在Excel中的Word Doc中查找文本不起作用-陷入困境

Question

This is something half way through being built so sorry if it's confusing

I have this code where I've defined a dictionary in excel. From there I want to find text from the 'Key' in a Word Document then once it's found I want to carry on with other coding.

The problem is, I've only gotten as far as the .find part and I can't work out for the life of me why it's not finding anything.

Draw your attention to the line:

For Each Key In Dict

All I've asked after that is to find the text in string C . I know for a fact that C contains a value, since I've added a MsgBox to check and I've also added it to the Clipboard so I can try and manually find the text - and I can if I search manually

But upon running/stepping through the code the .find.execute command seems to be somewhat ignored as though it's not even trying to search through the Document and blnFound Boolean comes back False every time, jumping to Next . I also have the document (Opened by the code) displaying on my screen at the time and nothing happens on it.

Can someone advise me of what I'm doing wrong here? I'm completely baffled.

Thanks!

Sub FindReplaceInWord2()

    Dim Wbk As Workbook: Set Wbk = ThisWorkbook
    Dim Wrd As New Word.Application
    Dim Dict As Object
    Dim RefList As Range, RefElem As Range
    Dim A As String
    Dim B As String
    Dim C As String
    Dim test As New DataObject
    Dim blnFound As Boolean    

    Wrd.Visible = True

    Dim TokenDoc As Document
    Set TokenDoc = Wrd.Documents.Open("\\SERVER\Client\Table.dot")        

    Set Dict = CreateObject("Scripting.Dictionary")
    Set RefList = Wbk.Sheets("Sheet1").Range("A1:A236") 

    With Dict
        For Each RefElem In RefList
        On Error Resume Next
            If Not .Exists(RefElem) And Not IsEmpty(RefElem) Then
            A = RefElem.Value
           .Add RefElem.Value, RefElem.Offset(0, 1).Value
            B = RefElem.Value

              End If
        Next RefElem
    End With

    For Each Key In Dict

    Set test = New DataObject
    'MsgBox Key
    test.SetText (Key)
    test.PutInClipboard
    C = Key
    MsgBox C
     With Wrd.ActiveDocument.Find

     .Text = C

    End With
   blnFound =  Wrd.ActiveDocument.Find.Execute        

        If blnFound = True Then
            MsgBox = "Yay for working it out"
            Else
        MsgBox = "Boo, it didn't Work"
        End If
    Next Key      

End Sub

PS. I've also tried

   Wrd.Selection.Find.text = C
   blnFound = Wrd.Selection.Find.Execute

and adding this before the find

   TokenDoc.Activate

Answer 1

Is this what you are trying ( Tried and Tested on a Local Template File )

Sub FindReplaceInWord2()
    Dim Wbk As Workbook: Set Wbk = ThisWorkbook
    Dim RefList As Range, RefElem As Range

    Dim col As New Collection
    Dim itm

    Dim blnFound As Boolean

    Dim Wrd As New Word.Application
    Dim TokenDoc As Document

    Wrd.Visible = True

    'Set TokenDoc = Wrd.Documents.Open("D:\Users\SidzPc\Desktop\Temp\Table.dot")
    Set TokenDoc = Wrd.Documents.Open("\\SERVER\Client\Table.dot")

    Set RefList = Wbk.Sheets("Sheet1").Range("A1:A236")

    For Each RefElem In RefList
        On Error Resume Next
        col.Add RefElem.Value, CStr(RefElem.Value)
        On Error GoTo 0
    Next RefElem

    For Each itm In col
        With Wrd.Selection.Find
            .Text = itm
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With

        blnFound = Wrd.Selection.Find.Execute

        If blnFound = True Then
            MsgBox "Yay for working it out"
        Else
            MsgBox "Boo, it didn't Work"
        End If
    Next itm
End Sub