VBA Content.Find在Word中，如何返回值找到的文本

Question

我想修改代碼從http://www.ozgrid.com/forum/showthread.php?t=174699

看起來在一個文件夾中的所有Word文檔，並在列返回一個「x」的權利，如果一個搜索到的值被找到。 列名稱是文件夾中的文檔。行名稱是搜索的字符串。

我想要例程返回一個值或字符串，在word文檔中找到的權利或旁邊搜索字符串。

這將是一個很好的工具來收集日期，發票值，名稱等從Word文檔中的非結構化數據Excel表。

With oDOC.Content.Find 

       .ClearFormatting 
       .Text = rCell.Value 
       .MatchCase = False 
       .MatchWholeWord = False 

       .Execute 

       If .Found Then 

        'Sheet1.Cells(rCell.Row, lngCol).Value = "x" , returns an "x" if the word is found. 


       End If 

      End With 

完整的代碼如下：

Public Sub SearchDocs() 

    Dim oWRD As Object '** Word.Application 
    Dim oDOC As Object '** Word.Document 
    Dim oFound As Object '** Word.Range 

    Dim rCell As Excel.Range 
    Dim lngCol As Long 

    Dim strFile As String 

    On Error GoTo ErrHandler 

    Application.ScreenUpdating = False 
    lngCol = 1 

    '** Set oWRD = New Word.Application 

    Set oWRD = CreateObject("Word.Application") 
    oWRD.Visible = True 

    '// XL2007 specific 
    Sheet1.Range("B2:XFD100000").ClearContents 

    strFile = Dir$(Sheet1.Range("B1").Value & "\*.doc?") 
    lngCol = 2 

    '// loop matching files 
    Do While strFile <> vbNullString 
     'open 
     Set oDOC = oWRD.Documents.Open(Sheet1.Range("B1").Value & "\" & strFile) 

     With Sheet1.Cells(2, lngCol) 
      .Value = strFile 
      .HorizontalAlignment = xlCenter 
      .VerticalAlignment = xlBottom 
      .WrapText = False 
      .Orientation = 90 
      .EntireColumn.ColumnWidth = 3.35 
     End With 

     For Each rCell In Sheet1.Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row) 

      With oDOC.Content.Find 

       .ClearFormatting 
       .Text = rCell.Value 
       .MatchCase = False 
       .MatchWholeWord = False 
       .Forward = False 
       .Execute 

       If .Found Then 
         'Selection.Collapse wdCollapseEnd 
         'Selection.Expand wdWord 
        'Sheet1.Cells(rCell.Row, lngCol).Value = "x" 
        'Sheet1.Cells(rCell.Row, lngCol).Value = .Text 
        Sheet1.Cells(rCell.Row, lngCol).Value = .Parent.Selection.Text 

       End If 

      End With 
     Next 
     Application.ScreenUpdating = True 
     DoEvents 
     Application.ScreenUpdating = False 
     lngCol = lngCol + 1 


     oDOC.Close 
     '// get next file 
     strFile = Dir$() 

    Loop 

    MsgBox "Finshed...", vbInformation 

ErrHandler: 
    Application.ScreenUpdating = True 
    oWRD.Application.Quit 

End Sub 

我不能在網上找到，或者弄明白，怎麼回事範圍內找到的文本，然後它偏移將文本/值返回到右側。我知道偏移存在於vba excel中。但如何抵消找到的字符串的範圍，並返回在此偏移量範圍中找到的值爲excel？

Answer 1

這種方法可能有效。通過初始化一個Range對象你要搜索

Set oFound = oDOC.Content 

的範圍內，那麼代替With oDOC.Content.Find做

With oFound.Find 

當.Found = True，oFound將被移動到找到的文本開始。然後，您可以通過1個字的東西，如移動oFound：

With oFound 
    .MoveEnd Unit:=wdWord, Count:=1 
    .MoveStart Unit:=wdWord, Count:=1 
End With 

您可以調整Unit和Count按您的要求。根據您的需要，相關的距離對象方法MoveEndUntil,MoveEndWhile,MoveStartUntil和MoveStartWhile可能會提供更好的功能。看看這些和其他Range.Move方法here。

希望幫助

Answer 2

的榮譽屬於xidgel。非常感謝。它像一個魅力。

編輯後的代碼，根據xidgel的方向可能會有所幫助別人，讓我貼吧：

Public Sub SearchDocs() 

    Dim oWRD As Object '** Word.Application 
    Dim oDOC As Object '** Word.Document 
    Dim oFound As Object '** Word.Range 



    Dim rCell As Excel.Range 
    Dim lngCol As Long 

    Dim strFile As String 

    'On Error GoTo ErrHandler 

    Application.ScreenUpdating = False 
    lngCol = 1 

    '** Set oWRD = New Word.Application 

    Set oWRD = CreateObject("Word.Application") 
    oWRD.Visible = True 



    '// XL2007 specific 
    Sheet1.Range("B2:XFD100000").ClearContents 

    strFile = Dir$(Sheet1.Range("B1").Value & "\*.doc?") 
    lngCol = 2 

    '// loop matching files 
    Do While strFile <> vbNullString 
     'open 
     Set oDOC = oWRD.Documents.Open(Sheet1.Range("B1").Value & "\" & strFile) 
     Set oFound = oDOC.Content 


     With Sheet1.Cells(2, lngCol) 
      .Value = strFile 
      .HorizontalAlignment = xlCenter 
      .VerticalAlignment = xlBottom 
      .WrapText = False 
      .Orientation = 90 
      .EntireColumn.ColumnWidth = 3.35 
     End With 

     For Each rCell In Sheet1.Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row) 

      With oFound.Find     'With oDOC.Content.Find 
       Debug.Print rCell.Value 

       .ClearFormatting 
       .Text = rCell.Text 
       .MatchCase = False 
       .MatchWholeWord = False 
       .Forward = True 
       .MatchWildcards = True 
       .Wrap = wdFindContinue 
       .Execute 

       Debug.Print .Found 

       If .Found Then 

        With oFound 
         .Collapse wdCollapseEnd 
         .Expand wdWord 

         .MoveStart Unit:=wdWord, Count:=1 
         .MoveEnd Unit:=wdWord, Count:=5 

        End With 

        Sheet1.Cells(rCell.Row, lngCol).Value = oFound.Text 
        Debug.Print oFound.Text 

       End If 

      End With 
     Next 
     Application.ScreenUpdating = True 
     DoEvents 
     Application.ScreenUpdating = False 
     lngCol = lngCol + 1 


     oDOC.Close 
     '// get next file 
     strFile = Dir$() 

    Loop 

    MsgBox "Finshed...", vbInformation 

ErrHandler: 
    Application.ScreenUpdating = True 
    oWRD.Application.Quit 

End Sub