Is there a way to get Specific subfolder level names and put in a column

I am using the following code to maintain a list of files in a specific server directory. We use this list as a Table of Contents and the sub folder names are based on Manufacture and then Type. We now have some additional classifications that we want to use under each type that can create additional subfolders. If those additional subfolders get created, the columns on the TOC that match to the Type and the Manufacture will no longer work as coded. Is there a way to program it to always get the 6th and 7th folder from the File Path and put them in the columns that they are associated with so that if the Type subfolder ends up with additional subfolders, the TOC with always display the Manufacture and Type for that particular file? See Lines 17, 18, 20-23 of attached file. The folders listed are not the Manufacture and Type, They are Type and Sub Type.

Sub RecursiveFolder(objFolder As Scripting.Folder, IncludeSubFolders As Boolean)

     'Declare the variables
     Dim objFile As Scripting.File
     Dim objSubFolder As Scripting.Folder
     Dim NextRow As Long, lr As Long, Filename As Range
     Dim ws1 As Worksheet, d As Date, NewFile As Range
     
     Set ws1 = ThisWorkbook.Sheets("Sheet1")
     lr = ws1.Range("B" & Rows.Count).End(xlUp).Row
     Set Filename = ws1.Range("B2:B" & lr)
     
     'Find the next available row
     NextRow = Cells(Rows.Count, "B").End(xlUp).Row + 1
     
     'Loop through each file in the folder
    For Each objFile In objFolder.Files
     'Look for New Files
        With ws1.Range("B2:B" & lr)
                Set NewFile = .Find(What:=objFile.Name, _
                After:=.Cells(.Cells.Count), _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=False)
            If NewFile Is Nothing Then
                    ws1.Cells(NextRow, "B").Value = objFile.Name
                        ws1.Cells(NextRow, "B").Select
                        ws1.Hyperlinks.Add Anchor:=Selection, Address:=(objFile.Path), TextToDisplay:=Selection.Text
                    ws1.Cells(NextRow, "C").Value = objFile.DateCreated
                    ws1.Cells(NextRow, "D").Value = objFolder.Name
                    ws1.Cells(NextRow, "E").Value = objFolder.ParentFolder.Name
                    
                    NextRow = NextRow + 1
            End If
        End With
    Next objFile

     'Loop through files in the subfolders
     If IncludeSubFolders Then
         For Each objSubFolder In objFolder.SubFolders
             Call RecursiveFolder(objSubFolder, True)
         Next objSubFolder
     End If
     
    Call Sort
     
End Sub