List files in folders in excel

This should do what you want.
This will put the list in the 1st 3 columns of the ActiveSheet.
Edit ShowFileList() to put in the folder and extension desired.
Just select the sheet you want the list on, make sure the 1st 3 columns don't have anything in them you want to keep, and run "ShowFileList()"
Be sure and back up your workbook 1st, in case there's a bug I didn't see.

Sub ShowFileList()
    Dim sFolder as string, sExtension as string

    'Change the Folder and extension to proper choices
    sFolder = "C:\Users\Bill\Documents\Computer\Excel\Excel Help"
    sExtension = ".xls"

    ListFolderFiles sFolder, sExtension
End Sub

Sub ListFolderFiles(FolderSpec, FileExtension, Optional ByRef vFiles)
    Dim fs, f1, fc, s, fFolder, fDate As Date
    Dim lCount As Long
    Dim fSubFolders, fSubFolder, bSubFolder As Boolean
    Dim aFiles()
    Dim r As Range

    Set fs = CreateObject("Scripting.FileSystemObject")
    If Not fs.FolderExists(FolderSpec) Then
        MsgBox FolderSpec & " is not a valid folder"
    Else
        Set fFolder = fs.GetFolder(FolderSpec)
        Set fc = fFolder.Files
        Set fSubFolders = fFolder.subfolders
        FileExtension = Trim(LCase(FileExtension)) & " "
        If Not IsMissing(vFiles) Then
            bSubFolder = True
            aFiles() = vFiles
            lCount = UBound(aFiles(), 2) + 1
        Else
            ReDim aFiles(1 To 3, 1 To 1)
            aFiles(1, 1) = "Folder"
            aFiles(2, 1) = "File"
            aFiles(3, 1) = "Last Modified"
            lCount = 2
        End If
        ReDim Preserve aFiles(1 To 3, 1 To lCount + 1)
        aFiles(1, lCount + 1) = FolderSpec

        For Each f1 In fc
            If InStr(LCase(f1) & " ", FileExtension) > 0 Then
                lCount = lCount + 1
                ReDim Preserve aFiles(1 To 3, 1 To lCount)
                aFiles(2, lCount) = f1.Name
                aFiles(3, lCount) = f1.DateLastModified
            End If
        Next
        If fSubFolders.Count > 0 Then
            For Each fSubFolder In fSubFolders
                ListFolderFiles fSubFolder, FileExtension, aFiles
            Next fSubFolder
        ElseIf bSubFolder Then
            vFiles = aFiles()
        End If
        If Not bSubFolder Then
            If UBound(aFiles(), 2) > 0 Then
                With ActiveSheet
                   .Range("A1").Resize(UBound(aFiles(), 2), UBound(aFiles(), 1)).Value = Transpose(aFiles())

                    Set r = .Columns("A:C")
                    r.EntireColumn.AutoFit
                End With
            End If
        End If
    End If
End Sub

Sorry about that. I saw that you were using Excel 2007 (which I'm not) and I included a function that I thought 2007 had. I was wrong. I should have looked it up first.
I've put it all in a file, so it should work right.List.xls

It's written in Excell 2002, but it should still work in 2007.
I tried moving up 2 folder levels to see if it gets bogged down with too many files, and it didn't list any. There's obviously a bug in it. I'll work on it.

jayblack;

Ok, here is the file List.xls. I tested it on several folders. Also added StatusBar entries, so you can see that it's working and not stuck. It went through over 4900 folders and 120,000 files without a hitch.

My Pleasure. If you really like it, rate it by clicking the blue scales above right side of screen.

jayblack;

I'll keep this thread in my subscriptions list for at least a month, in case you write more. After that you'll have to send me a private message to let me know you're back