Sub ProcessWordDocs()
Dim wd As Object 'Word.Application
Dim doc As Object 'Word.Document
Dim aDoc
Dim strDoc As String
Dim strProduct As String
Dim strDocName
Dim rs As DAO.Recordset
Dim rsProc As DAO.Recordset
Dim j As Long
Dim r As Range


   'On Error GoTo ProcessWordDocs_Error

    Set wd = CreateObject("Word.Application")
    wd.Visible = True
    aDoc = Dir("C:\Docs\*.doc")
    
    Do While aDoc <> ""
    
        strDoc = "C:\Docs\" & aDoc
        Set doc = wd.Documents.Open _
            (FileName:=strDoc, AddToRecentFiles:=False)
                
    For j = 1 To 2
    Set r = doc.Sentences(j)
    With r.Find
            .ClearFormatting
            .Font.Underline = 1 'wdUnderlineSingle
            .Text = ""
            .Wrap = 1 'wdFindContinue

            r.Find.Execute

            If r.Find.Found Then
            strProduct = r
            Else
            strProduct = "NONE: " & aDoc
            End If
   End With
   Next j

        
        doc.Close
        
        Debug.Print strProduct


        aDoc = Dir
    Loop
    
    Set doc = Nothing
    wd.Quit
    Set wd = Nothing
End Sub