How to Copy Highlighted Text and File Path in Word Using VBA In Windows 10

Question

This excellent VBA code finds all of the yellow highlighted text in all Word docs within a specified folder or directory:

Sub ExtractHighlightedTextsInSameColorFromMultiDoc()
  Dim objDoc As Document, objDocAdd As Document
  Dim strFile As String, strFolder As String
  Dim objRange As Range

  '  Initialization
  strFolder = "C:\Users\Public\Documents\New folder\"
  strFile = Dir(strFolder & "*.docx", vbNormal)

  Set objDocAdd = Documents.Add

  '  Precess each file in the file folder.
  While strFile <> ""
  Set objDoc = Documents.Open(FileName:=strFolder & strFile)

  With Selection
    .HomeKey Unit:=wdStory
    With Selection.Find
      .Highlight = True
      Do While .Execute
        If Selection.Range.HighlightColorIndex = wdYellow Then
          Set objRange = Selection.Range
          objDocAdd.Range.InsertAfter objRange & vbCr
          Selection.Collapse wdCollapseEnd
        End If
      Loop
    End With
  End With

  objDoc.Close
  strFile = Dir()
  Wend
End Sub

But I would also like the VBA script to copy the file path that the highlighted text was copied from, like this:

Paste highlighted text number 1
Paste file path for document where Highlighted text number 1 was found
Paste highlighted text number 2
Pate file path for document where Highlighted text number 2 was found
Paste highlighted text number 3
Paste file path for document where Highlighted text number 3 was found
Etc.

How should I revise the script to capture the file paths, as well as highlighted text sections?

Credit for the VBA script above: https://www.datanumen.com/blogs/2-handy-methods-extract-highlighted-texts-word-document/

Answer 1

Try adding 'objDocAdd.Range.InsertAfter strFolder & strFile & vbCr' after the existing InsertAfter line.