VBE macro that creates shortcuts which include the autor of the linked file as property

Question

this is my first question so I would love to improve my style and such. Just tell me if I am doing something completely wrong.

My question: I am searching files with a specific extensions. All results get printed to excel and then create shortcuts to each file which get then stored in a folder. This works perfectly fine for now, but I need the shortcut to include the author detail to filter all entries (hundreds to thousends) for it. The result should be a shortcut with the same properties that you get when using the 'create shortcut' from context menu vie right click.

I hope you can help my since I am trying to get this to work for a while now.

If you know a solution, that does what I need but is maybe written in a different language that is fine for me as long as the user does not have to install runtimes/libraries (sory I am a complete beginner)

My code:

'This function searches for files with endings (ppt,pptx,pptm) and pastes the found entries into the excel sheet

Function Recurse(sPath As String) As String  

    Dim FSO As New FileSystemObject
    Dim myFolder As Folder
    Dim mySubFolder As Folder
    Dim myFile As File

    Set myFolder = FSO.GetFolder(sPath)
    Set Extensions = CreateObject("Scripting.Dictionary")
    Extensions.CompareMode = 1 ' make lookups case-insensitive
    'Extensions.Add Range("C5").Value, True
    Extensions.Add "pptx", True
    Extensions.Add "ppt", True
    Extensions.Add "pptm", True

    For Each mySubFolder In myFolder.SubFolders
        For Each myFile In mySubFolder.Files
            '
            i = Range("D4").Value
            If Extensions.Exists(FSO.GetExtensionName(myFile)) Then
                Cells(8 + i, 3).Value = myFile.Name
                Cells(8 + i, 4).Value = myFile.Path 
                i = i + 1
                Range("D4").Value = i  'storing number of entrys found
                'Exit For
            End If
        Next
        Recurse = Recurse(mySubFolder.Path)
    Next

End Function

'This Function creates a folder with the name "A1" if it does not exist already

Function PathExist(ByVal vPfadName As String) As Boolean

scutPath = Application.ActiveWorkbook.Path & "\" & Range("A1").Value

On Error GoTo ErrorPathExist

ChDir (vPfadName)

PathExist = True

Exit Function

ErrorPathExist:
    MkDir scutPath

End Function

'Main Function that clears table and uses the found entries to get create shortcuts. Unfortunately the author is not integrated when doing it this way. The author is necessary to filter through hundreds of results.

Sub TestR()
        Range("B8:C999999") = ""
        Range("D4").Value = 0
    Call Recurse(Application.ActiveWorkbook.Path)

    i = 1
    scutPath = Application.ActiveWorkbook.Path & "\" & Range("A1").Value

    Call PathExist(scutPath)

    For i = 1 To 200 '(last line)

    Set oWSH = CreateObject("WScript.Shell")

Set oShortcut = oWSH.CreateShortCut(scutPath & "\" & Cells(7 + i, 3).Value & ".lnk")
With oShortcut
.TargetPath = Cells(7 + i, 4).Value
.Save
End With
Set oWSH = Nothing

Next i

    MsgBox "Done"

End Sub