Getting all sub folders and files within a folder

[UsmanBPD]

Hello all, I have the following problem:

I run my sub which opens up a folder browser, however this only gets the folder, when I would like it to get files and sub folders within the folder.

Function GetSubDir(ByVal sPath As String, Optional ByVal sPattern As Variant) As Variant

Dim sDir As String
Dim sDirLocationForText As String

On Error GoTo Err_Clk

If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"

If IsMissing(sPattern) Then
sDir = Dir$(sPath, vbDirectory)
Else
sDir = Dir$(sPath & sPattern, vbDirectory)
End If
Do Until LenB(sDir) = 0

If sDir <> "." And sDir <> ".." Then
sDirLocationForText = sDirLocationForText & ";" & sPath & sDir
End If
sDir = Dir$

Loop

If Left$(sDirLocationForText, 1) = ";" Then sDirLocationForText = Right(sDirLocationForText, Len(sDirLocationForText) - 1)
GetSubDir = sDirLocationForText
End Function

Any help would be greatly appreciated.

[UsmanBPD]

BUMP

I got told to use 'vbNormal' instead of 'vbDirectory' in my code, however nothing changes. Any ideas?

[mike7952]

Maybe you can adapt this. Change the path below in red. Also make sure you have sheet1 in workbook. Will list all folders/files/subfolders/files.

 'Force the explicit delcaration of variables
 'Option Explicit
Sub ListFiles()
    Dim objFSO As Object
    'Set a reference to Microsoft Scripting Runtime by using
     'Tools > References in the Visual Basic Editor (Alt+F11)
     
     'Declare the variable
     Set objFSO = CreateObject("Scripting.FileSystemObject")
     
     'Insert the headers for Columns A through F
     Range("A1").Value = "Folder"
     Range("B1").Value = "File Name"
     Range("C1").Value = "File Size"
     Range("D1").Value = "File Type"
     Range("E1").Value = "Date Created"
     Range("F1").Value = "Date Last Accessed"
     Range("G1").Value = "Date Last Modified"
     
     'Create an instance of the FileSystemObject
     Set objFSO = CreateObject("Scripting.FileSystemObject")
     
     'Call the RecursiveFolder routine
     Call RecursiveFolder(objFSO, "C:\Users\Mike\Desktop\Andrew", True)
     
     'Change the width of the columns to achieve the best fit
     Columns.AutoFit
     
 End Sub
 
Private Sub RecursiveFolder( _
     FSO As Object, _
     MyPath As String, _
     IncludeSubFolders As Boolean)
 
    'Declare the variables
     Dim File As Object
     Dim Folder As Object
     Dim SubFolder As Object
     Dim NextRow As Long
     
     'Find the next available row
     NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
     
     'Get the folder
     Set Folder = FSO.GetFolder(MyPath)
     
     'Loop through each file in the folder
     For Each File In Folder.Files
         Cells(NextRow, "A").Value = Folder.Name
         Cells(NextRow, "B").Value = File.Name
         Cells(NextRow, "C").Value = File.Size
         Cells(NextRow, "D").Value = File.Type
         Cells(NextRow, "E").Value = File.DateCreated
         Cells(NextRow, "F").Value = File.DateLastAccessed
         Cells(NextRow, "G").Value = File.DateLastModified
         NextRow = NextRow + 1
     Next File
     
     'Loop through files in the subfolders
     If IncludeSubFolders Then
         For Each SubFolder In Folder.SubFolders
             Call RecursiveFolder(FSO, SubFolder.Path, True)
         Next SubFolder
     End If
     
 End Sub