Tuesday, August 2, 2022

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

No comments:

Post a Comment