List Files

List Full Path – This will list all the files in the selected folder
copy both sections into one module

Option Explicit
Dim objFSO As Object
Dim objFile As Object, objFiles As Object
Dim objSubFolder As Object, objSubFolders As Object
Sub ListFilesFullPath()
On Error GoTo ErrorFound
Cells.Clear
Dim StartFolder As String
Dim flDlg As FileDialog
Dim r As Long
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set flDlg = Application.FileDialog(msoFileDialogFolderPicker)
flDlg.InitialFileName = Application.DefaultFilePath & "\"
If flDlg.Show = False Then Exit Sub
StartFolder = flDlg.SelectedItems(1)
If Right(StartFolder, 1) <> "\" Then StartFolder = StartFolder & "\"
Set objFiles = objFSO.GetFolder(StartFolder).Files
For Each objFile In objFiles
r = WorksheetFunction.CountA(Range("A:A")) + 1
Cells(r, 1) = objFile
DoEvents
Next objFile
Set objFiles = Nothing
Set objFSO = Nothing
MsgBox "Done!"
Exit Sub
ErrorFound:
MsgBox Err.Description
On Error Resume Next
On Error GoTo 0
End Sub
 

List Full Path (including subfolders) – This will list all the files in the selected folder with subfolders
copy all 3 sections into one module

Option Explicit
Dim objFSO As Object
Dim objFile As Object, objFiles As Object
Dim objSubFolder As Object, objSubFolders As Object
Sub ListFilesFullPath()
Cells.Clear
Dim StartFolder As String
Dim flDlg As FileDialog
Set flDlg = Application.FileDialog(msoFileDialogFolderPicker)
flDlg.InitialFileName = Application.DefaultFilePath & "\"
If flDlg.Show = False Then Exit Sub
StartFolder = flDlg.SelectedItems(1)
If Right(StartFolder, 1) <> "\" Then StartFolder = StartFolder & "\"
Call Recursive_ListFilesFullPath(StartFolder)
Set objFSO = Nothing
MsgBox "Done!"
End Sub
Sub Recursive_ListFilesFullPath(strFolder As String)
Dim r As Long
On Error GoTo ErrorFound
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFiles = objFSO.GetFolder(strFolder).Files
Set objSubFolders = objFSO.GetFolder(strFolder).Subfolders
For Each objFile In objFiles
r = WorksheetFunction.CountA(Range("A:A")) + 1
Cells(r, 1) = objFile
DoEvents
Next objFile
Set objFiles = Nothing
For Each objSubFolder In objSubFolders
Call Recursive_ListFilesFullPath(objSubFolder.Path)
Next objSubFolder
Set objSubFolders = Nothing
Exit Sub
ErrorFound:
MsgBox Err.Description
On Error Resume Next
On Error GoTo 0
End Sub

Split path and filename (including subfolders) – This will list all the files in the selected folder with subfolders
copy all 3 sections into one module

Option Explicit
Dim objFSO As Object
Dim objFile As Object, objFiles As Object
Dim objSubFolder As Object, objSubFolders As Object
Dim PosOfLastBackslash As Long
Sub ListFilesSplitPathFile()
Cells.Clear
Dim StartFolder As String
Dim flDlg As FileDialog
Set flDlg = Application.FileDialog(msoFileDialogFolderPicker)
flDlg.InitialFileName = Application.DefaultFilePath & "\"
If flDlg.Show = False Then Exit Sub
StartFolder = flDlg.SelectedItems(1)
If Right(StartFolder, 1) <> "\" Then StartFolder = StartFolder & "\"
Call Recursive_ListFilesSplitPathFile(StartFolder)
Set objFSO = Nothing
MsgBox "Done!"
End Sub
Sub Recursive_ListFilesSplitPathFile(strFolder As String)
Dim r As Long
On Error GoTo ErrorFound
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFiles = objFSO.GetFolder(strFolder).Files
Set objSubFolders = objFSO.GetFolder(strFolder).Subfolders
For Each objFile In objFiles
PosOfLastBackslash = InStrRev(objFile, "\")
r = WorksheetFunction.CountA(Range("A:A")) + 1
Cells(r, 1) = Left(objFile, PosOfLastBackslash)
Cells(r, 2) = objFile.Name
DoEvents
Next objFile
Set objFiles = Nothing
For Each objSubFolder In objSubFolders
Call Recursive_ListFilesSplitPathFile(objSubFolder.Path)
Next objSubFolder
Set objSubFolders = Nothing
Exit Sub
ErrorFound:
MsgBox Err.Description
On Error Resume Next
On Error GoTo 0
End Sub

Split path, filename and file extension (including subfolders) – This will list all the files in the selected folder with subfolders
copy all 3 sections into one module

Option Explicit
Dim objFSO As Object
Dim objFile As Object, objFiles As Object
Dim objSubFolder As Object, objSubFolders As Object
Dim PosOfLastDot As Long
Dim PosOfLastBackslash As Long
Sub ListFilesSplitPathFileExt()
Cells.Clear
Dim StartFolder As String
Dim flDlg As FileDialog
Set flDlg = Application.FileDialog(msoFileDialogFolderPicker)
flDlg.InitialFileName = Application.DefaultFilePath & "\"
If flDlg.Show = False Then Exit Sub
StartFolder = flDlg.SelectedItems(1)
If Right(StartFolder, 1) <> "\" Then StartFolder = StartFolder & "\"
Call Recursive_ListFilesSplitPathFileExt(StartFolder)
Set objFSO = Nothing
MsgBox "Done!"
End Sub
Sub Recursive_ListFilesSplitPathFileExt(strFolder As String)
Dim r As Long
On Error GoTo ErrorFound
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFiles = objFSO.GetFolder(strFolder).Files
Set objSubFolders = objFSO.GetFolder(strFolder).Subfolders
For Each objFile In objFiles
PosOfLastBackslash = InStrRev(objFile, "\")
PosOfLastDot = InStrRev(objFile.Name, ".")
r = WorksheetFunction.CountA(Range("A:A")) + 1
Cells(r, 1) = Left(objFile, PosOfLastBackslash)
If PosOfLastDot = 0 Then
Cells(r, 2) = objFile.Name
Cells(r, 3) = ""
Else
Cells(r, 2) = Left(objFile.Name, PosOfLastDot - 1)
Cells(r, 3) = Right(objFile.Name, Len(objFile.Name) - PosOfLastDot)
End If
DoEvents
Next objFile
Set objFiles = Nothing
For Each objSubFolder In objSubFolders
Call Recursive_ListFilesSplitPathFileExt(objSubFolder.Path)
Next objSubFolder
Set objSubFolders = Nothing
Exit Sub
ErrorFound:
MsgBox Err.Description
On Error Resume Next
On Error GoTo 0
End Sub