Extract list of filenames from Folder and Subfolders

[JumboCactuar]

Hi,
Can anyone suggest code that can do this efficiently?
I want full filepath output

I tried using Scripting.FileSystemObject but it's slow if there are many Subfolders

If not VBA, maybe powershell?
I tried using the term command but it cuts off if the filepath is long

Any help appreciated

Current code

Sub getfiles()

    Dim oFSO As Object
    Dim oFolder As Object
    Dim oFile As Object, sf
    Dim i As Long, colFolders As New Collection, ws As Worksheet
    
    i = 1
    
    Set ws = ActiveSheet
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.getfolder("C:\imagex")
    
    colFolders.Add oFolder          'start with this folder
    
    Do While colFolders.Count > 0      'process all folders
        Set oFolder = colFolders(1)    'get a folder to process
        colFolders.Remove 1            'remove item at index 1
    
        For Each oFile In oFolder.Files
                ws.Cells(i + 1, 1) = oFolder.Path
                ws.Cells(i + 1, 2) = oFile.Name
                i = i + 1
        Next oFile

        'add any subfolders to the collection for processing
        For Each sf In oFolder.subfolders
            colFolders.Add sf 'add to collection for processing
        Next sf
    Loop

End Sub

 

[Kerryx]

Does this one help from Fluff

VBA to list files and subfolder

Dears, I'm trying to update a code found on the web to list all files and subfolder in a folder. The problem I'm having is that I do not want to list also the content of subfolders. Example: Folder C:\Test Content C:\Test\Test1.txt C:\Test\Sub\Test2.txt Output C:\Test\Test1.txt or Test1.txt...

www.mrexcel.com

 

[Kerryx]

Sorry maybe not

 

[JumboCactuar]

Sorry maybe not

Thanks but yes that is similar to my existing code.

The closest i have got to something quick is using this powershell script

Get-ChildItem -Path 'c:\imageX\'  -File -Recurse |
select-object fullname | 
out-file 'c:\imageX\files.txt'

But if the filename is too long it cuts off

FYI - The folder size is 478GB

 

[Flaiban]

Try This. Anything , just adapt :

Sub Find_Supplier()

Dim folderName As String

With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select the Folder only up to the desired month"
.InitialFileName = Application.DefaultFilePath & "\" 'mudar a pasta inicial desejada
If .Show = 0 Then Exit Sub
folderName = .SelectedItems(1)
End With

Dim wrd As String
wrd = InputBox("Insert one or more Suppliers for Search. Separate by semicolon (ex. DHL;Rothmanns;Pirelli).", "Locator")
If wrd = "" Then
MsgBox "???", vbQuestion, "Locator"
Exit Sub
End If

Range("A2:B500").ClearContents 'clear contents in worksheet

Dim searchTerms As Variant
searchTerms = Split(Trim(wrd), ";") 'Trim() to remove spaces

Dim startRow As Long
startRow = 2 'Start line 2

Dim fileCount As Long
fileCount = 0

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

ProcessFolder fso, folderName, True, searchTerms, startRow, fileCount

MsgBox "Number of File(s) located: " & fileCount, vbInformation, "File(s) Found"

ActiveSheet.Range("A:B").EntireColumn.AutoFit
Range("A1").Value = "Folder"
Range("B1").Value = "Supplier"

Set fso = Nothing

End Sub

Private Sub ProcessFolder(ByVal fso As Object, ByVal folderName As String, ByVal includeSubfolders As Boolean, ByRef searchTerms As Variant, ByRef rowNumber As Long, ByRef fileCount As Long)

Dim currentFolder As Object
Dim currentSubFolder As Object
Dim currentFile As Object

Set currentFolder = fso.GetFolder(folderName)

For Each currentFile In currentFolder.Files
If isMatchFound(currentFile.Name, searchTerms) Then
Cells(rowNumber, "A").Value = currentFolder.Name
Cells(rowNumber, "B").Value = currentFile.Name
rowNumber = rowNumber + 1
fileCount = fileCount + 1
End If
Next currentFile

If includeSubfolders Then
For Each currentSubFolder In currentFolder.SubFolders
ProcessFolder fso, currentSubFolder, True, searchTerms, rowNumber, fileCount
Next currentSubFolder
End If

End Sub

Private Function isMatchFound(ByVal fileName As String, ByVal searchTerms As Variant) As Boolean

Dim i As Long

For i = LBound(searchTerms) To UBound(searchTerms)
If UCase(fileName) Like "*" & UCase(searchTerms(i)) & "*" Then
isMatchFound = True
Exit Function
End If
Next i

isMatchFound = False

End Function

 

[John_w]

Can anyone suggest code that can do this efficiently?
I want full filepath output

I tried using Scripting.FileSystemObject but it's slow if there are many Subfolders

This macro should be much faster.

Public Sub List_Files()

    Dim WSh As Object 'WshShell
    Dim FSO As Object 'Scripting.FileSystemObject
    Dim ts As Object 'Scripting.TextStream
    Dim folder As String
    Dim tempFile As String
    Dim command As String
    Dim dirLines As Variant
    Dim results() As String
    Dim i As Long, p As Long
        
    folder = "C:\imagex\"
    
    Set WSh = CreateObject("WScript.Shell") 'New WshShell
    Set FSO = CreateObject("Scripting.FileSystemObject") 'New Scripting.FileSystemObject

    If Right(folder, 1) <> "\" Then folder = folder & "\"
    tempFile = Environ$("temp") & "\dir.txt"
    command = "cmd /c DIR /B /S /A-D " & Q(folder) & " > " & Q(tempFile)
    WSh.Run command, 0, True
    
    Set ts = FSO.OpenTextFile(tempFile)
    If Not ts.AtEndOfStream Then
        dirLines = Split(ts.ReadAll, vbCrLf)
    End If
    ts.Close
    Kill tempFile
    
    If IsArray(dirLines) Then
    
        ReDim results(UBound(dirLines), 1)
        For i = 0 To UBound(dirLines)
            p = InStrRev(dirLines(i), "\")
            results(i, 0) = Left(dirLines(i), p)
            results(i, 1) = Mid(dirLines(i), p + 1)
        Next
    
        With ActiveSheet
            .Cells.Clear
            .Range("A1").Resize(UBound(dirLines) + 1, 2).Value = results
        End With
    
    End If
        
    MsgBox "Done"
       
End Sub


Private Function Q(text As String) As String
    Q = Chr(34) & text & Chr(34)
End Function

 

[JumboCactuar]

This macro should be much faster.

Public Sub List_Files()

    Dim WSh As Object 'WshShell
    Dim FSO As Object 'Scripting.FileSystemObject
    Dim ts As Object 'Scripting.TextStream
    Dim folder As String
    Dim tempFile As String
    Dim command As String
    Dim dirLines As Variant
    Dim results() As String
    Dim i As Long, p As Long
       
    folder = "C:\imagex\"
   
    Set WSh = CreateObject("WScript.Shell") 'New WshShell
    Set FSO = CreateObject("Scripting.FileSystemObject") 'New Scripting.FileSystemObject

    If Right(folder, 1) <> "\" Then folder = folder & "\"
    tempFile = Environ$("temp") & "\dir.txt"
    command = "cmd /c DIR /B /S /A-D " & Q(folder) & " > " & Q(tempFile)
    WSh.Run command, 0, True
   
    Set ts = FSO.OpenTextFile(tempFile)
    If Not ts.AtEndOfStream Then
        dirLines = Split(ts.ReadAll, vbCrLf)
    End If
    ts.Close
    Kill tempFile
   
    If IsArray(dirLines) Then
   
        ReDim results(UBound(dirLines), 1)
        For i = 0 To UBound(dirLines)
            p = InStrRev(dirLines(i), "\")
            results(i, 0) = Left(dirLines(i), p)
            results(i, 1) = Mid(dirLines(i), p + 1)
        Next
   
        With ActiveSheet
            .Cells.Clear
            .Range("A1").Resize(UBound(dirLines) + 1, 2).Value = results
        End With
   
    End If
       
    MsgBox "Done"
      
End Sub


Private Function Q(text As String) As String
    Q = Chr(34) & text & Chr(34)
End Function

Thankyou, this is great
much faster

 

[Sufiyan97]

This macro should be much faster.

Public Sub List_Files()

    Dim WSh As Object 'WshShell
    Dim FSO As Object 'Scripting.FileSystemObject
    Dim ts As Object 'Scripting.TextStream
    Dim folder As String
    Dim tempFile As String
    Dim command As String
    Dim dirLines As Variant
    Dim results() As String
    Dim i As Long, p As Long
       
    folder = "C:\imagex\"
   
    Set WSh = CreateObject("WScript.Shell") 'New WshShell
    Set FSO = CreateObject("Scripting.FileSystemObject") 'New Scripting.FileSystemObject

    If Right(folder, 1) <> "\" Then folder = folder & "\"
    tempFile = Environ$("temp") & "\dir.txt"
    command = "cmd /c DIR /B /S /A-D " & Q(folder) & " > " & Q(tempFile)
    WSh.Run command, 0, True
   
    Set ts = FSO.OpenTextFile(tempFile)
    If Not ts.AtEndOfStream Then
        dirLines = Split(ts.ReadAll, vbCrLf)
    End If
    ts.Close
    Kill tempFile
   
    If IsArray(dirLines) Then
   
        ReDim results(UBound(dirLines), 1)
        For i = 0 To UBound(dirLines)
            p = InStrRev(dirLines(i), "\")
            results(i, 0) = Left(dirLines(i), p)
            results(i, 1) = Mid(dirLines(i), p + 1)
        Next
   
        With ActiveSheet
            .Cells.Clear
            .Range("A1").Resize(UBound(dirLines) + 1, 2).Value = results
        End With
   
    End If
       
    MsgBox "Done"
      
End Sub


Private Function Q(text As String) As String
    Q = Chr(34) & text & Chr(34)
End Function

Hi @John_w

How to get date modified along with it, can you please help.

 

[John_w]

How to get date modified along with it, can you please help.

Replace the /B with /TW to get the directories and last written times in the listing. Then manipulate the dirLines array to extract directories, dates and times and file names into the results array.

Please start a new thread if you need more help.

 

[pjmorris]

My solution is a complete change in tack, but knowing what i now know about Powerquery there is no way I would use VBA to collect directory information. Follow the steps below and you will return a list of all files with the information you're after. You can remain in the Powerquery editor to filter on whatever parameters you need and potentially combine the files into a single data source:

1. Open the Data ribbon.
2. Click on little down arrow by the 'Get Data' and select 'From File' then 'From Folder'.
3. Navigate to the top of the folder structure of interest and click 'OK'.
4. In the dialogue box that appears select Transform Data.
5. You will now be in the Powerquery Editor.
6. On the Home ribbon select 'Close & Load'.

You will then have a table in excel that contains all files in the folder structure together with their Path, File Extension, Date/Time Accessed, Date/Time Modified, and Date/Time Created.

There is so much you can do with Powerquery and PowerPivot that getting to grips with them should be a key part of an excel users repertoire (in my opinion ).
HTH.