How to Get a List of Folders and Files Name from Selected Folder with VBA

 To compared files inside between folders it will be much easier if we have a list of folders and files name inside folder 1 and folder 2 in excel sheet then we can use formula true and false  or VLOOKUP function. To get the list we can use VBA code below:

Option Explicit
Sub GetFordersAndFilesNameInSelectedFolder()
    Dim pPath As String
    Dim FileName As String
    Dim MstWB As Workbook, MstWS As Worksheet
    Dim i As Integer
    
    'Open Dialog Box To Select Folder
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        If .Show <> -1 Then GoTo Line1
        pPath = .SelectedItems(1)
    End With
    
    'To ensure path end with slash
    If Right(pPath, 1) <> "\" Then
        pPath = pPath & "\"
    End If
    
    'Assign Filename string
    FileName = Dir(pPath, vbDirectory)
    
    'Create New Workbook with normal template
    Set MstWB = Workbooks.Add(1)
    Set MstWS = MstWB.ActiveSheet
    
    'Create Header
    MstWS.Range("A1") = "No."
    MstWS.Range("B1") = "Name"
    
    'Start Row to fill in
    i = 2
    
    'Loop To Get All File and Folrder name inside the folder
    Do While FileName <> ""
        If Left(FileName, 1) <> "." Then
            MstWS.Range("A" & i) = i - 1
            MstWS.Range("B" & i) = FileName
            i = i + 1
        End If
        FileName = Dir()
    Loop
    
    'Formatting
    MstWB.Activate
    MstWS.Rows(1).Font.Bold = True
    MstWS.Cells.EntireColumn.AutoFit
    MstWS.Cells.HorizontalAlignment = xlLeft
    ActiveWindow.WindowState = xlMaximized
    
Line1:
    
    'Clear Variables
    Set MstWB = Nothing
    Set MstWS = Nothing
    FileName = "": pPath = ""
End Sub

To use this code:

• Copy this and paste into module and Run this code
• Select any single folder
• New workbook will be created
• All folders and files name will be listed in Sheet1

Please try and give us feedback.Thanks You

How to create Folder and Subfolders with vba code

Normally to create a new folder just right click empty area at Desktop or inside any folders then click at New and click folder. By default the folder name is New Folder and we have to rename accordingly but if the folder name already exist then we have give another name. 

How to create Folder and Sub folders with VBA code?

A few items need to consider in order to create folder:

• Path or Directory
• Folder Existence
• Create Folder
  

Path or Directory - Common Directory:

• C (C:)
  
• Documents (C:\Users\Username\Documents)
  
• Desktop (C:\Users\Username\Desktop)

The problem is Username not fixed, it could be Admin, Guest or any name given. In order to get actual Username we use below code:

VBA.Environ ("UserProfile") 'This will give us C:\Users\Username
    'OR
VBA.Environ ("Username") 'This will give us Username

Folder existence

To check folder exists or not we use below code:   

YourPath = Environ("UserProfile") & "\" & "Desktop" & "\" & "Your Folder Name Here"
If Dir(YourPath, vbDirectory) = "" Then
     MkDir YourPath
End If

Create Folder

To create folder we use

MkDir YourPath

Below completed code to create folder and sub folder:

Option Explicit

Sub CreatingFolderAndSubFolder()
'Declare Variables
Dim StrOuterPath As String, StrInnerPath As String

'To Create New Folder name "Main Folder"
StrOuterPath = VBA.Environ("UserProfile") & "\" & "Desktop" & "\" & "Main Folder"

'To Create New Folder Inside Main Folder name "Sub Folder"
StrInnerPath = VBA.Environ("UserProfile") & "\" & "Desktop" & "\" & "Main Folder" & "\" & "Sub Folder"

'To Check Main Folder existence
If Dir(StrOuterPath, vbDirectory) = "" Then
    'To Create Main Folder
    MkDir StrOuterPath
    'To Create Sub Folder
    MkDir StrInnerPath
    MsgBox "Main and Sub Folder Successfully created"
Else
    'To Check Sub Folder existence
    If Dir(StrInnerPath, vbDirectory) = "" Then
        'To Create Sub Folder
        MkDir StrInnerPath
        MsgBox "Sub Folder Successfully created"
    Else
        MsgBox "Main Folder and Sub Folder already exist"
    End If
End If

'Reset Variables
StrOuterPath = "": StrInnerPath = ""

End Sub

Thank You

Microsoft Reference (MkDir)