'Rename PDF based on its content

How do I specifically extract the name from a PDF (screenshot as shown below) and rename the PDF as the name? So in this case, I want to extract Daniel Thomas from 'Feedback for Daniel Thomas' and rename my PDF file as it is. I have a total of 180 files; a sample the code I got from online, please help.

Sub RenamePDF()
Dim sh As Shape
Dim sDirectory As String
Dim sFile As String
Dim sText As String
Dim lSetting As Long
Dim i As Integer

Application.DisplayAlerts = wdAlertsNone
lSetting = Options.ConfirmConversions
Options.ConfirmConversions = False

sDirectory = "C:\Users\user123\Desktop\"
sFile = Dir(sDirectory & "\" & "*.pdf")
Do While sFile <> ""
    Documents.Open FileName:=sDirectory & "\" & sFile
    For Each sh In ActiveDocument.Shapes
        If sh.Type = 6 Then '6 is a grouped shape
            For i = 1 To sh.GroupItems.Count
                If sh.GroupItems(i).Type = 1 Then '1 is a rectangle
                    sText = sh.GroupItems(4).TextFrame.TextRange.Text 'explicitly get 4th rectangle
                    Exit For
                End If
            Next i
        End If
    Next sh
    sText = Left(sText, Len(sText) - 1)
    ActiveDocument.Close False
    Name sDirectory & sFile As sDirectory & Split(sFile, "-")(0) & " - " & sText & ".pdf"
    sFile = Dir
Loop
Options.ConfirmConversions = lSetting
Application.DisplayAlerts = wdAlertsAll
End Sub

enter image description here



Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source