Try:
Sub UpdateData()
    Application.ScreenUpdating = False
    Dim wdApp As Object, wdDoc As Object, wdRng As Object
    Dim WkSht As Worksheet, LRow As Long, i As Long
    Dim strFldr As String, strFile As String, StrDoc As String
    Dim FSObj As Object, FSOFile As Object, DtTm As Date
    Set WkSht = ThisWorkbook.Sheets("Sheet1")
    LRow = WkSht.UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row
    Set wdApp = CreateObject("Word.Application")
    If wdApp Is Nothing Then
        MsgBox "Can't start Word.", vbExclamation
        Exit Sub
    End If
    With WkSht
        For i = 1 To LRow
            If LCase(.Cells(i, 1).Text) = "true" Then
                strFldr = .Cells(i, 2).Text
                If Dir(strFldr, vbDirectory) = "" Then
                    .Cells(i, 3).Value = "Please check Folder Location"
                Else
                    If FSObj Is Nothing Then Set FSObj = CreateObject("Scripting.FileSystemObject")
                    'loop through each file and get date last modified. If largest date then store Filename
                    DtTm = DateSerial(1900, 1, 1)
                    strFile = Dir(strFldr & "\*.doc", vbNormal)
                    While strFile <> ""
                        Set FSOFile = FSObj.GetFile(strFldr & "\" & strFile)
                        If FSOFile.DateLastModified > DtTm Then
                            DtTm = FSOFile.DateLastModified
                            StrDoc = strFldr & "\" & strFile
                        End If
                        strFile = Dir()
                    Wend
                    Set FSOFile = Nothing
                    Set wdDoc = wdApp.Documents.Open(Filename:=StrDoc, _
                        AddToRecentFiles:=False, Visible:=False, ReadOnly:=True)
                    With wdDoc
                        With .Range
                            With .Find
                                .ClearFormatting
                                .Replacement.ClearFormatting
                                .Forward = True
                                .Wrap = 0 'wdFindStop
                                .Format = True
                                .Style = "Heading 1"
                                .MatchWildcards = False
                                .MatchCase = False
                                .Text = "Summary^p"
                                .Replacement.Text = ""
                                .Execute
                            End With
                            If .Find.Found = True Then
                                Set wdRng = .Duplicate
                                wdRng.Collapse 0 'wdCollapseEnd
                            End If
                            .Start = wdRng.End
                            With .Find
                                .Text = "Conclusion"
                                .Execute
                            End With
                            If .Find.Found = True Then
                                wdRng.End = .Duplicate.Start - 1
                            End If
                            If Not wdRng Is Nothing Then
                                With wdRng
                                    While .Tables.Count > 0
                                        .Tables(1).Delete
                                    Wend
                                    While .Shapes.Count > 0
                                        .Shapes(1).Delete
                                    Wend
                                    While .InlineShapes.Count > 0
                                        .InlineShapes(1).Delete
                                    Wend
                                    With .Find
                                        .ClearFormatting
                                        .Replacement.ClearFormatting
                                        .Forward = True
                                        .Wrap = 0 'wdFindStop
                                        .Format = False
                                        .MatchWildcards = True
                                        .Text = "[^13^l]{1,}"
                                        .Replacement.Text = Chr(182)
                                        .Execute Replace:=2 'wdReplaceAll
                                    End With
                                    If Len(.Text) > 1 Then
                                        .Copy
                                        With WkSht
                                            .Paste .Cells(i, 3)
                                        End With
                                    Else
                                        WkSht.Cells(i, 3).Value = "No Data"
                                    End If
                                End With
                            Else
                                WkSht.Cells(i, 3).Value = "Not Found"
                            End If
                        End With
                        .Close SaveChanges:=False
                    End With
                    Set wdRng = Nothing
                End If
            End If
        Next
         '.Columns(3).Cells.Replace What:="¶", Replacement:=Chr(10), _
        LookAt:=xlPart, SearchOrder:=xlByRows
        .Columns(3).WrapText = True
    End With
    wdApp.Quit
    Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
    Application.ScreenUpdating = True
End Sub
PS: The code tags are inserted via the # button on the posting menu.