CODEWITHSUNDEEP
vbaexcel
David Fontijn
David Fontijn

Reputation: 3

List filenames in subfolders

I'm trying to list filenames from .txt files in seperate folders to seperate columns in Excel.(sample picture) I found the code below, which works nice, but does not include subfolders or placement in specific column with folder header.

Can someone please point me in the right direction here?

Option Explicit
Sub GetFileNames()
Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$
InitialFoldr$ = "C:\main folder dir\"
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirect$ = .SelectedItems(1) & "\"
xFname$ = Dir(xDirect$, 7)
Do While xFname$ <> ""
ActiveCell.Offset(xRow) = xFname$
xRow = xRow + 1
xFname$ = Dir
Loop
End If
End With
End Sub

So:

Subfoldername1 | Subfoldername2
-------------- | --------------
Textfile1      | Textfile3 
Textfile2      | Textfile4

Upvotes: 0

Views: 216

Answers (2)

ASH
ASH

Reputation: 20302

Please see the link below. I think this will do what you want, or at least, it will get you very close to where you need to be.

http://learnexcelmacro.com/wp/2011/11/how-to-get-list-of-all-files-in-a-folder-and-sub-folders/

enter image description here

Upvotes: 0

Plagon
Plagon

Reputation: 3138

Try this: 

Sub FolderNames()
Dim sht As Worksheet
Dim fso As Object, fl1 As Object, fl2 As Object
Dim lCol As Long
Dim Files As String, sPath As String

Set fso = CreateObject("Scripting.FileSystemObject")
Set sht = Worksheets("Sheet1")

With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Title = "Please Select a Folder"
    .Show
    If .SelectedItems.Count <> 0 Then sPath = .SelectedItems(1)
End With

Set fl1 = fso.GetFolder(sPath)

With sht
    lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    If .Cells(1, lCol).Value = "" Then
        .Cells(1, lCol) = sPath
    Else
        .Cells(1, lCol + 1) = sPath
    End If
End With

For Each fl2 In fl1.SubFolders
    lCol = sht.Cells(1, sht.Columns.Count).End(xlToLeft).Column
    sht.Cells(1, lCol + 1).Value = Right(fl2, Len(fl2) - InStrRev(fl2, "\"))
    Files = Dir(fl2 & "\*.txt")
    Do While Files <> ""
        With sht
            lrow = .Cells(.Rows.Count, lCol + 1).End(xlUp).Row
            .Cells(lrow + 1, lCol + 1).Value = Files
        End With
        Files = Dir()
    Loop
Next
sht.Columns.AutoFit
End Sub

It will list the selected path and the all folders with .txt in them. But not sub-subfolders. Output:

enter image description here

Upvotes: 1

Related Questions