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

Question

这是构建过程的一半，如果感到困惑，请抱歉

我在excel中定义字典的地方有此代码。 从那里我想从Word文档中的“关键字”中查找文本，然后一旦找到，我就希望继续进行其他编码。

问题是，我只找到了.find部分，而我无法终生解决为什么找不到任何东西。

提请注意以下内容：

For Each Key In Dict

我所要问的就是在字符串C找到文本。 我知道C包含一个值，因为我已经添加了一个MsgBox进行检查，并且我也将其添加到了剪贴板中，所以我可以尝试手动查找文本-如果我手动搜索也可以

但是在运行/单步执行代码时，似乎似乎忽略了.find.execute命令，好像它甚至没有尝试搜索Document一样，并且blnFound布尔每次都返回False，跳转到Next 。 当时我的屏幕上还显示有文档（由代码打开），但没有任何反应。

有人可以告诉我我在这里做错了什么吗？ 我完全困惑。

谢谢！

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。 我也尝试过

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

并将其添加到查找之前

   TokenDoc.Activate

Answer 1

这是您要尝试的吗（ 在本地模板文件上经过测试 ）

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