Dir function to return files in top level and subfolders

KGee

Well-known Member
Joined
Nov 26, 2008
Messages
526
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Is it possible to use the Dir function to get a list of all files in the root folder as well as the files in any subfolders below the root folder?
 

Some videos you may like

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,406
To list files in the root folder and subfolders, run the 'ListFiles' macro. It lists the folder name in Column A and the file name in Column B of the active sheet.

Code:
[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] ListFiles()

    [color=darkblue]Dim[/color] strPath [color=darkblue]As[/color] [color=darkblue]String[/color]

    [color=green]'Change the path accordingly[/color]
    strPath = "C:\Users\Domenic\Desktop\test\"
    
    [color=darkblue]Call[/color] ProcessDirs(strPath)
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

[color=darkblue]Sub[/color] ProcessDirs([color=darkblue]ByVal[/color] CurrDir [color=darkblue]As[/color] [color=darkblue]String[/color])

    [color=darkblue]Dim[/color] Dirs() [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] strFile [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] NextRow [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] Cnt [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Long[/color]

    [color=darkblue]If[/color] Right(CurrDir, 1) <> "\" [color=darkblue]Then[/color] CurrDir = CurrDir & "\"
    
    strFile = Dir(CurrDir & "*.*", vbDirectory)
    
    [color=darkblue]Do[/color] [color=darkblue]While[/color] Len(strFile) > 0
        [color=darkblue]If[/color] Left(strFile, 1) <> "." [color=darkblue]Then[/color]
            [color=darkblue]If[/color] (GetAttr(CurrDir & strFile) And vbDirectory) = vbDirectory [color=darkblue]Then[/color]
                Cnt = Cnt + 1
                [color=darkblue]ReDim[/color] [color=darkblue]Preserve[/color] Dirs(1 [color=darkblue]To[/color] Cnt)
                Dirs(Cnt) = CurrDir & strFile
            [color=darkblue]Else[/color]
                NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
                Cells(NextRow, "A").Value = CurrDir
                Cells(NextRow, "B").Value = strFile
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]End[/color] [color=darkblue]If[/color]
        strFile = Dir
    [color=darkblue]Loop[/color]
    
    [color=darkblue]For[/color] i = 1 [color=darkblue]To[/color] Cnt
        [color=darkblue]Call[/color] ProcessDirs(Dirs(i))
    [color=darkblue]Next[/color] i
    
[color=darkblue]End[/color] Sub
[/font]
 

KGee

Well-known Member
Joined
Nov 26, 2008
Messages
526
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi Domenic,

Thanks for the help once again. I've got a short day today so I'll try this out next week. I also stubled upon the FileSearch object in the help file which has an example.

Thanks again.
 

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,406
You're very welcome! Note, however, that FileSearch is not supported in Excel 2007 and 2010.
 

KGee

Well-known Member
Joined
Nov 26, 2008
Messages
526
Office Version
  1. 365
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

Thanks for the heads up. We are still using 2003 but will be upgrading to 2007 over the summer.
 

tabibito86

New Member
Joined
Mar 8, 2014
Messages
3
Hello Domenic,

I have seen your marco and it is exactly what I was looking for!

I have been trying to adapt your marco to perform a file search based on a reference cell. The reference cell (in my case D2) can then be filled with any search word. For example, I have a file called "car prices" in a sub folder "prices" of the directory. If I now type the word "car" in cell D2 I was hoping to look up that string with the wild card search that i defined.

Unfortunately, the search doesn't work any more on the sub folders unless I leave Cell D2 empty. Would you happen to know why the function cannot find the file inside the sub folder? The reason why I added the wildcard before and after is to search for any file type

Here is the marco that I adapted from yours:

Code:
[INDENT]Option Explicit

Sub ListFiles()

    Dim strPath As String

    'Change the path accordingly
    strPath = "C:\Users\Steffen Warnke\Desktop\FAQ Folder"
    
    Call ProcessDirs(strPath)
    
End Sub
[/INDENT]
 [INDENT]Sub ProcessDirs(ByVal CurrDir As String)

    Dim Dirs() As String
    Dim strFile As String
    Dim NextRow As Long
    Dim Cnt As Long
    Dim i As Long

    If Right(CurrDir, 1) <> "\" Then CurrDir = CurrDir & "\"
    
    strFile = Dir(CurrDir & "*" & Range("D2") & "*", vbDirectory)
    
    Do While Len(strFile) > 0
        If Left(strFile, 1) <> "." Then
            If (GetAttr(CurrDir & strFile) And vbDirectory) = vbDirectory Then
                Cnt = Cnt + 1
                ReDim Preserve Dirs(1 To Cnt)
                Dirs(Cnt) = CurrDir & strFile
            Else
                NextRow = Cells(Rows.Count, "F").End(xlUp).Row + 1
                Cells(NextRow, "F").Value = CurrDir & strFile
            End If
        End If
        strFile = Dir
    Loop
    
    For i = 1 To Cnt
        Call ProcessDirs(Dirs(i))
    Next i
    
End Sub
[/INDENT]

Thanks a lot for your advice!
 

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,406

ADVERTISEMENT

Hello Domenic,

I have seen your marco and it is exactly what I was looking for!

I have been trying to adapt your marco to perform a file search based on a reference cell. The reference cell (in my case D2) can then be filled with any search word. For example, I have a file called "car prices" in a sub folder "prices" of the directory. If I now type the word "car" in cell D2 I was hoping to look up that string with the wild card search that i defined.

Unfortunately, the search doesn't work any more on the sub folders unless I leave Cell D2 empty. Would you happen to know why the function cannot find the file inside the sub folder? The reason why I added the wildcard before and after is to search for any file type.

Thanks a lot for your advice!

Try...

Code:
Option Explicit

Sub ListFiles()
    Dim strPath As String
    'Change the path accordingly
    strPath = "C:\Users\Steffen Warnke\Desktop\FAQ Folder"   
    Call ProcessDirs(strPath)
End Sub

Sub ProcessDirs(ByVal CurrDir As String)

    Dim Dirs() As String
    Dim strFile As String
    Dim NextRow As Long
    Dim Cnt As Long
    Dim i As Long
    If Right(CurrDir, 1) <> "\" Then CurrDir = CurrDir & "\"
    
   [COLOR=#ff0000] strFile = Dir(CurrDir & "*.*", vbDirectory)
[/COLOR]    
    Do While Len(strFile) > 0
        If Left(strFile, 1) <> "." Then
            If (GetAttr(CurrDir & strFile) And vbDirectory) = vbDirectory Then
                Cnt = Cnt + 1
                ReDim Preserve Dirs(1 To Cnt)
                Dirs(Cnt) = CurrDir & strFile
            Else
                [COLOR=#ff0000]If strFile Like "*" & Range("D2").Value & "*" Then[/COLOR]
                    NextRow = Cells(Rows.Count, "F").End(xlUp).Row + 1
                    Cells(NextRow, "F").Value = CurrDir & strFile
                [COLOR=#ff0000]End If
[/COLOR]            End If
        End If
        strFile = Dir
    Loop
    
    For i = 1 To Cnt
        Call ProcessDirs(Dirs(i))
    Next i
    
End Sub
 

apo

Well-known Member
Joined
Nov 3, 2008
Messages
581
Hi..

This will list all your files (filenames only) in Column A and then list a hyperlink to each file on Column B.

Enter your search term in Cell D2.

Change filepath it searches to suit in the code..

Code:
Private Sub CommandButton2_Click()
    Dim z, x() As String, i As Long, Str As String, xx
    Application.ScreenUpdating = False
    z = "C:\Users\Apo\Desktop\Excel Test Files\"
    Str = "*" & Cells(2, 4).Value & "*"
    x() = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & z & Str & ".*"" /b/a-d/s ").stdout.readall, vbCrLf)
    For i = LBound(x) To UBound(x) - 1
        xx = Split(x(i), "\")
        Cells(i + 1, 1).Value = Split(x(i), "\")(UBound(xx))
        ActiveSheet.Hyperlinks.Add Cells(i + 1, 2), CreateObject("scripting.filesystemobject").getfile(x(i) & "\").Path
    Next i
    Application.ScreenUpdating = True
End Sub
 

tabibito86

New Member
Joined
Mar 8, 2014
Messages
3
Good morning Domenic & Apo,

thank you guys for your quick help! It both works like a charm. :)

For convenience I prefer your solution Apo as I am trying to set up an FAQ folder whereby the user should find topics of interest form all the sub folders (which will later be very nested). Therefore it is a very need idea to include a hyperlink so that you can open the right file straight away.

I also noticed why sometimes the function couldn't find a certain string. It seems that the search function is case sensitive. In the German language it is quite common that nouns are written in upper case. Is it also possible to perform the same search regardless of upper or lower case?


Anyhow, thanks again for your great support guys! You really helped me a lot.

Best regards!
 

apo

Well-known Member
Joined
Nov 3, 2008
Messages
581
If you put the code in a Module.. try putting:

Code:
Option Compare text

above the sub..
 

Watch MrExcel Video

Forum statistics

Threads
1,122,469
Messages
5,596,316
Members
414,053
Latest member
Dual Showman

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
Top