RESOLVED[File listing script]

[Fonty]

I'm doing a list of files and it's properties for some files contained in some subdirectories. For this I'm using a script I found here , for which I have only few options like these:

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long
    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)
    r = Range("A65536").End(xlUp).Row + 1
' File properties:
    For Each FileItem In SourceFolder.Files
        Cells(r, 1).Formula = FileItem.ParentFolder
        Cells(r, 2).Formula = FileItem.Name
        Cells(r, 3).Formula = FileItem.Size
        Cells(r, 4).Formula = FileItem.Type
        Cells(r, 5).Formula = FileItem.DateCreated
        Cells(r, 6).Formula = FileItem.DateLastAccessed
        Cells(r, 7).Formula = FileItem.DateLastModified
        Cells(r, 8).Formula = FileItem.Drive
        r = r + 1
    Next FileItem
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.Path, True
        Next SubFolder
    End If
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
End Sub

What I want to add is the name of individual subfloders. For example, for 2 files:
C:\folder\subfolder1\subfolder2\file1
C:\folder\subfolder1\file2

I'd like to have

Name Folde1 Folder2 Folder3
file1 folder subfolder1 subfolder2
file2 folder subfolder1

I'm able to do something like this using MID() and FIND() instructions in the sheet, however I'd like to automate it.

[DKenny]

Try the following, it will add the folder details to the right of your exist data.
Note: I have also replaced your .Formula properties with .Value - no need to use the .formula property if you are not writing a formula

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long, x As Long
Dim asFolders() As String
 
    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)
    r = Range("A65536").End(xlUp).Row + 1
' File properties:
    For Each FileItem In SourceFolder.Files
        Cells(r, 1).Value = FileItem.ParentFolder
        Cells(r, 2).Value = FileItem.Name
        Cells(r, 3).Value = FileItem.Size
        Cells(r, 4).Value = FileItem.Type
        Cells(r, 5).Value = FileItem.DateCreated
        Cells(r, 6).Value = FileItem.DateLastAccessed
        Cells(r, 7).Value = FileItem.DateLastModified
        Cells(r, 8).Value = FileItem.Drive
        asFolders = Split(FileItem.ParentFolder, "\")
        For x = 1 To UBound(asFolders)
            Cells(r, 8 + x).Value = asFolders(x)
        Next x
        r = r + 1
    Next FileItem
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.Path, True
        Next SubFolder
    End If
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
End Sub