Question

我正在尝试修改http://www.ozgrid.com/forum/showthread.php?t=174699

中的代码

查看文件夹中的所有word文档并返回＆＃39; x＆＃39;在列中，如果找到搜索的值。列名是文件夹中的文档。行名称是搜索的字符串。

我希望例程返回一个值或字符串，它在右侧的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将移至找到的文字。然后，您可以将oFound移动1个单词，例如：

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

VBA Content.Find in Word，如何返回找到的文本的权利

2 个答案: