using VBA folder picker to select multiple folders and echo their names as list in a range

[AkaTrouble]

hello

how can you use the :-

Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

.AllowMultiSelect = True

to simply paste a list of the selected folders to a range on the current worksheet.

also could this be done for file picker too


i only posted the code as i know this works in other code i have so i must have the correct libraries set as active. I have asked the question this way rather than ask how to list all folders in a directory as there ar lots of codes out there to do this but most also include subfolders which is not what i need, also this code would be more flexible for my current project.

thanks for reading


EDITED just for reference this is the other working code i am using if it helps to understand my thinking what i ask is possiblr to achieve

'Force the explicit delcaration of variables
Option Explicit

Sub ListFiles()

    Application.ScreenUpdating = False

    'Set a reference to Microsoft Scripting Runtime by using
    'Tools > References in the Visual Basic Editor (Alt+F11)
    
    'Declare the variables
    Dim objFSO As Scripting.FileSystemObject
    Dim objTopFolder As Scripting.Folder
    Dim strTopFolderName As String
       
    'Assign the top folder to a variable
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Title = "Pick a folder"
        .Show
        If .SelectedItems.Count = 0 Then MsgBox "Operation Cancelled by the user", vbExclamation + vbOKOnly, "List Files": Exit Sub
        strTopFolderName = .SelectedItems(1)
    End With
                 
    ' create a new sheet
    'ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)).Name = Mid$(strTopFolderName, InStrRev(strTopFolderName, "\") + 1)
    ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)).Name = Left(Mid$(strTopFolderName, InStrRev(strTopFolderName, "\") + 1), 30)
    
    
    'Insert the headers for Columns A through F
    Range("A1").Value = "File Name"
    Range("B1").Value = "Ext"
    Range("C1").Value = "File Name"
    Range("D1").Value = "File Size"
    Range("E1").Value = "File Type"
    Range("F1").Value = "Date Created"
    Range("G1").Value = "Date Last Accessed"
    Range("H1").Value = "Date Last Modified"
    Range("I1").Value = "File Path  CLICK TO LAUNCH DEFAULT APPLICATION WITH FILE"
    Range("J1").Value = "PATH"
    Range("K1").Value = "RENAME"
    Range("L1").Value = "NewNameAndPath"
      
        
    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    'Get the top folder
    Set objTopFolder = objFSO.GetFolder(strTopFolderName)
    
    'Call the RecursiveFolder routine
    Call RecursiveFolder(objTopFolder, True)
    
    'Change the width of the columns to achieve the best fit
    Columns.AutoFit
    
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("A1").CurrentRegion, , xlYes).TableStyle = "TableStyleLight1"
    
    Application.ScreenUpdating = True
End Sub

Sub RecursiveFolder(objFolder As Scripting.Folder, _
    IncludeSubFolders As Boolean)

       
    'Declare the variables
    Dim objFile As Scripting.File
    Dim objSubFolder As Scripting.Folder
    Dim NextRow As Long
    
    'Find the next available row
    NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    'Loop through each file in the folder
    For Each objFile In objFolder.Files
        'to take complete filename in column C  and extract filename without extension lso allowing for fullstops in filename itself
        Cells(NextRow, "A") = "=LEFT(RC[+2],FIND(""#"",SUBSTITUTE(RC[+2],""."",""#"",LEN(RC[+2])-LEN(SUBSTITUTE(RC[+2],""."",""""))))-1)"
        
        
        'to take complete filename from row C and show only its extension
        Cells(NextRow, "B") = "=TRIM(RIGHT(SUBSTITUTE(RC[+1],""."",REPT("" "",LEN(RC[+1]))),LEN(RC[+1])))"
        
        
        Cells(NextRow, "C").Value = objFile.Name
        
    Select Case objFile.Size
        Case 0 To 1023
            Cells(NextRow, "D").Value = Format(objFile.Size, "0") & "B"
        Case 1024 To 1048575
            Cells(NextRow, "D").Value = Format(objFile.Size / 1024, "0") & "KB"
        Case 1048576 To 1073741823
            Cells(NextRow, "D").Value = Format(objFile.Size / 1048576, "0") & "MB"
        Case 1073741824 To 1.11111111111074E+20
            Cells(NextRow, "D").Value = Format(objFile.Size / 1073741823, "0.00") & "GB"
    End Select
        
     
        'Cells(NextRow, "D").Value = Format((objFile.Size / 1024 / 1024), "000") & " MB"
        Cells(NextRow, "E").Value = objFile.Type
        Cells(NextRow, "F").Value = objFile.DateCreated
        Cells(NextRow, "G").Value = objFile.DateLastAccessed
        Cells(NextRow, "H").Value = objFile.DateLastModified
        Cells(NextRow, "I").Value = objFile.Path
                
                
                
        Cells(NextRow, "J") = "=LEFT(RC[-1],FIND(""#"",SUBSTITUTE(RC[-1],""\"",""#"",LEN(RC[-1])-LEN(SUBSTITUTE(RC[-1],""\"",""""))))-0)"
        '=LEFT(I2,FIND("#",SUBSTITUTE(I2,"\","#",LEN(I2)-LEN(SUBSTITUTE(I2,"\",""))))-0)
        
        Cells(NextRow, "K").Value = "=R[+0]C[-10]"
        
        
        
        Cells(NextRow, "L") = "=CONCATENATE(RC[-2],RC[-1],""."",RC[-10])"
        
        '=CONCATENATE(J2,K2,".",B2)
        
        Cells(NextRow, "J") = "=LEFT(RC[-1],FIND(""#"",SUBSTITUTE(RC[-1],""\"",""#"",LEN(RC[-1])-LEN(SUBSTITUTE(RC[-1],""\"",""""))))-0)"
        '=LEFT(I2,FIND("#",SUBSTITUTE(I2,"\","#",LEN(I2)-LEN(SUBSTITUTE(I2,"\",""))))-0)
        
        
        Cells(NextRow, "L") = "=CONCATENATE(RC[-2],RC[-1],""."",RC[-10])"
        
        '=CONCATENATE(J2,K2,".",B2)
        
                        
        ActiveSheet.Hyperlinks.Add Cells(NextRow, "I"), objFile.Path
        
        
        NextRow = NextRow + 1
    Next objFile
    
    'Loop through files in the subfolders
    If IncludeSubFolders Then
        For Each objSubFolder In objFolder.SubFolders
            Call RecursiveFolder(objSubFolder, True)
        Next objSubFolder
    End If
    
        
End Sub