Dir function to return files in top level and subfolders

[KGee]

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?

 

[Domenic]

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.

[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]

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]

You're very welcome! Note, however, that FileSearch is not supported in Excel 2007 and 2010.

 

[KGee]

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

 

[tabibito86]

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:

[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]

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...

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]

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..

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]

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]

If you put the code in a Module.. try putting:

Option Compare text

above the sub..