Extract data from multiple Word files into Excel

[SmallFry]

I have several documents and I need to extract a date from directly after a key word. The paragraph will one be the word and the date.

Example: Approval Date. 10 January 2018

I would like to extract the date and the file name to excel. This code will extract the date and place the file name, but the find is only finding the 2018. Not sure how to move the cursor all the way back to the day.

Code: Select all

Sub Word_tables_from_many_docx_to_Excel()
    Dim myPath  As String
    Dim myFile  As String
    Dim myText  As String
    Dim xlRow   As Long
    Dim xl      As Object: Set xl = CreateObject("excel.application")
        
    xl.Workbooks.Add
    xl.Visible = True
    
    myPath = "C:\Users\SmallFry\Desktop\Word Replace\"
    myFile = Dir(myPath & "*.docx")
    
    xlRow = 1
    Do While myFile <> ""
        Documents.Open myPath & myFile
        Selection.HomeKey Unit:=wdStory
        With Selection.Find
           .ClearFormatting
           .MatchWildcards = True
           .Text = "Approval Date.  ([0-9]{1,}) (<[AFJMNSOD]*>) ([0-9]{4})"
           .Execute
        End With
        Selection.Collapse Direction:=wdCollapseEnd
        Selection.MoveStartWhile Cset:="0123456789", Count:=wdBackward
        myText = Selection.Text
        xl.ActiveWorkbook.ActiveSheet.Cells(xlRow, 1) = myText
        xl.ActiveWorkbook.ActiveSheet.Cells(xlRow, 2) = myFile
        xlRow = xlRow + 1
        ActiveWindow.Close False
        myFile = Dir
    Loop

End Sub

[HansV]

Instead of

Code: Select all

        Selection.Collapse Direction:=wdCollapseEnd
        Selection.MoveStartWhile Cset:="0123456789", Count:=wdBackward

use

Code: Select all

        Selection.MoveStart Count:=Len("Approval Date.  ")

This moves the start of the selection to just before the date, and leaves the end where it was.

[SmallFry]

This is wonderful Hans. Thanks again for your time.