List Files in Folder & Subfolder and Rename

[exc4libur]

Hi all,

Normally, I organize my files through excel. I list and describe them, sometimes I need to rename a few and sometimes I want to get the files inside subfolders.

Can anyone help modify the code below to add these new features with a msgbox yes/no; 1) include subfolders, 2) rename files from column "Q".

Option Explicit
Sub Directory()
If MsgBox("Are you sure? Pending: File rename and export option", vbYesNo) = vbYes Then
Application.ScreenUpdating = False
Application.CutCopyMode = False
Application.DisplayAlerts = False

'IMPORTANT
'Make sure to add a Reference to Microsoft Scripting Runtime

Dim myName As String
Dim fromPath As String
Dim recRow As Long
Dim myCell As Range
Dim rngFound As Range
Dim rngDelete As Range
Dim c As Range
Dim FSO As Object, _
ShellApp As Object, _
fileInFolder As Object

Set FSO = CreateObject("scripting.filesystemobject")

With ActiveWorkbook.ActiveSheet

'Folder path
    Set ShellApp = CreateObject("Shell.Application"). _
    Browseforfolder(0, "Please choose a folder", 0, "c:\\")
    fromPath = ShellApp.self.Path
'Column Check
    recRow = .Cells(.Rows.Count, "O").End(xlUp).Row + 1

    'Error check
    If Right(fromPath, 1) = "\" Then
        fromPath = Left(fromPath, Len(fromPath) - 1)
    End If
   
    If FSO.FolderExists(fromPath) = False Then
        MsgBox fromPath & " doesn't exist"
        Exit Sub
    End If
       
    For Each fileInFolder In FSO.getfolder(fromPath).Files
        'Check if file listed
        Set rngFound = Nothing
'Column Check
        Set rngFound = .Range("O:O").Find(what:=fileInFolder.Name, lookat:=xlWhole)
        If rngFound Is Nothing Then
            'File not already listed
'Column Check
            Set myCell = .Cells(recRow, "O")
            myCell.Value = fileInFolder.Name
            .Cells(recRow, "M").Value = Int(fileInFolder.DateLastModified)
            .Cells(recRow, "N").Value = Format(fileInFolder.Size / 1000, "0")
            .Cells(recRow, "P    ").Value = Format(fileInFolder.Path)
            'Add hyperlink
            myCell.Hyperlinks.Add myCell, fromPath & "\" & fileInFolder.Name
           
            'Increment counter
            recRow = recRow + 1
        End If
    Next fileInFolder

End With
End If
End Sub

Thanks in advance.
Rgds,
Exc4.