bring files from folders and subfolders to multiple columns based on folders names

tubrak

Board Regular
Joined
May 30, 2021
Messages
218
Office Version
  1. 2019
Platform
  1. Windows
hi

I need macro to brings all files from folder and subfolders to multiple columns so my directory isle "C:\Users\mm\Desktop\FILES" it contains many subfolders FILE1 up to FILE 6 and it's increasable and each subfolder contain files are different in extensions so it should create the headers based on subfolders names and bring the files for each column separately and hyperlink to open them
this should result after run macro
 
thanks very much for your solution
I have some question when I create the formatting and borders the code it deletes it may you fix it ,please and if there is way hide hyperlink without show underline and blue color it will be great
and if it's possible I would press the headers then open the folder
thanks again
 
Upvote 0

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
Hi again,:)
try this:
VBA Code:
Sub Test3()
    
    'https://www.mrexcel.com/board/threads/bring-files-from-folders-and-subfolders-to-multiple-columns-based-on-folders-names.1172585/
    
    Dim oFSO As Object
    Dim folder As Object
    Dim subfolders As Object
    Dim xFile As Object
    Dim Wks As Worksheet
    Dim rowIndex As Long
    Dim Col As Integer
    
    Col = 1
    rowIndex = 2
    
    Set Wks = ThisWorkbook.Sheets("Foglio1")        '==>> TO ADAPT
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set folder = oFSO.GetFolder("C:\Users\39320\Desktop\Forum")        '==>> TO ADAPT
    Set subfolders = folder.subfolders
    
    Application.ScreenUpdating = False
    
    Wks.UsedRange.ClearContents
    
    For Each subfolders In folder.subfolders
        
        With Wks.Cells(1, Col)
            .Value = subfolders.Name
            .Hyperlinks.Add Anchor:=Wks.Cells(1, Col), Address:=subfolders
            .Font.Color = vbBlack
            .Font.Underline = xlUnderlineStyleNone
        End With
        
        For Each xFile In subfolders.Files
            
            With Application.ActiveSheet.Cells(rowIndex, Col)
                .Formula = xFile.Name
                .Hyperlinks.Add Anchor:=Cells(rowIndex, Col), Address:=subfolders & "\" & xFile.Name
                .Font.Color = vbBlack
                .Font.Underline = xlUnderlineStyleNone
            End With
            
            rowIndex = rowIndex + 1
        Next xFile
        
        Col = Col + 1
        rowIndex = 2
    Next subfolders
    
    Wks.Columns.AutoFit
    
    Application.ScreenUpdating = True
    
    Set oFSO = Nothing
    Set folder = Nothing
    Set subfolders = Nothing
    
End Sub
 
Upvote 0
Solution
I run this Sub Demo1() but shows in cell A1 " Nothing !"
As it well works on my side since last century with different Excel versions & computers so check the path in the constant P …​
 
Upvote 0
@Marc L I re copy the path but it just shows main folder name is FILE as in my directory :confused:
 
Upvote 0

Forum statistics

Threads
1,223,910
Messages
6,175,316
Members
452,634
Latest member
cpostell

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top