Microsoft Office Forums - View Single Post - [Solved] Looking for VBA code that can FIND and SELECT any text based on its properties

Guessed · 01-13-2022, 04:19 PM

You can modify the ProcessDocument sub to extract the relevant titles however you need to. I don't have much confidence that searching for Times New Roman 12pt is an approach that will work consistently but changing the code to look for those attributes is easy enough.

Code:

Sub ProcessDocument(objWordDoc As Document, aSheet As Worksheet)
  Dim aRng As Word.Range, sFound As String, iRow As Integer
  Set aRng = objWordDoc.Content
  With aRng.Find
    .ClearFormatting
    .Font.Name = "Times New Roman"
    .Font.Bold = True
    .Forward = True
    .Wrap = wdFindStop
    .Text = ""

    If .Execute = True Then
      sFound = aRng.Text
      iRow = aSheet.UsedRange.Rows.Count + 1
      sFound = Trim(Replace(sFound, vbCr, "")) 'replace paragraph marks with a space
      aSheet.Cells(iRow, 1).Value = sFound
      aSheet.Cells(iRow, 2).Value = objWordDoc.Name
      aRng.Start = aRng.End
      Do While .Execute = True
        sFound = Trim(Replace(aRng.Text, vbCr, ""))
        aSheet.Cells(iRow, 1).Value = aSheet.Cells(iRow, 1).Value & " " & sFound
        aRng.Start = aRng.End
      Loop
    End If
  End With
End Sub

The rest of the code doesn't need to change