List All Files In A Folder Excel 2007

[lavppp]

Hello to all,

The code below works great for listing all the files of a specific folder, but the moment I try to modify it I get in trouble. I would like the macro NOT to generate a new folder but always use the same folder plus I don't want that first line in cell A1 saying "The files found in..."

This is my first experience with Excel 2007 and it's becoming very painfull. Thank you all for your help!

********************************************

Sub ListAllFile()

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim ws As Worksheet

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set ws = Worksheets.Add

'Get the folder object associated with the directory
Set objFolder = objFSO.GetFolder("C:\")
ws.Cells(1, 1).Value = "The files found in " & objFolder.Name & "are:"

'Loop through the Files collection
For Each objFile In objFolder.Files
ws.Cells(ws.UsedRange.Rows.Count + 1, 1).Value = objFile.Name
Next

'Clean up!
Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing

End Sub

 

[Michael M]

This is the code I use

'-----------------------------------------------------------
'You must reference the Microsoft Scripting Runtime library
'    From within the VBE:
'    1) Goto Tools | References
'    2) Check box for Microsoft Scripting Runtime.
'-----------------------------------------------------------

Sub TestListFilesInFolder()
    Workbooks.Add
    With Range("A1")
        .Formula = "Folder contents:"
        .Font.Bold = True
        .Font.Size = 12
    End With
    Range("A3").Formula = "File Name:"
    Range("B3").Formula = "File Size:"
    Range("C3").Formula = "File Type:"
    Range("D3").Formula = "Date Created:"
    Range("E3").Formula = "Date Last Accessed:"
    Range("F3").Formula = "Date Last Modified:"
    Range("G3").Formula = "Attributes:"
    Range("H3").Formula = "Short File Name:"
    Range("A3:H3").Font.Bold = True
    
ListFilesInFolder "C:\data", False'change path to suit

End Sub
*************
Sub ListFilesInFolder(SourceFolderName As String, _
            IncludeSubfolders As Boolean)

Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long

    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)
    r = Cells(Rows.Count, 1).End(xlUp).Row + 1
    For Each FileItem In SourceFolder.Files
        ' display file properties
        Cells(r, 1).Formula = FileItem.Path & FileItem.Name
        Cells(r, 2).Formula = FileItem.Size
        Cells(r, 3).Formula = FileItem.Type
        Cells(r, 4).Formula = FileItem.DateCreated
        Cells(r, 5).Formula = FileItem.DateLastAccessed
        Cells(r, 6).Formula = FileItem.DateLastModified
        Cells(r, 7).Formula = FileItem.Attributes
        Cells(r, 8).Formula = FileItem.ShortPath & FileItem.ShortName
        r = r + 1 ' next row number
    Next FileItem

    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.Path, True
        Next SubFolder
    End If

    Columns("A:H").AutoFit
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
    ActiveWorkbook.Saved = True

End Sub

 

[Trevor G]

Try this

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> mefiles1()<br><SPAN style="color:#007F00">'List files in a folder</SPAN><br><SPAN style="color:#007F00">'Clear anything first</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> F <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>Sheets("Sheet1").Range("A:A").Clear<br><br>F = Dir("m:\Access Files\*.xls")<br>Range("A1").Activate<br><br><SPAN style="color:#00007F">Do</SPAN> <SPAN style="color:#00007F">While</SPAN> Len(F) > 0<br>ActiveCell.Formula = F<br>ActiveCell.Offset(1, 0).Select<br><br>F = Dir()<br><SPAN style="color:#00007F">Loop</SPAN><br></FONT>

 

[Michael M]

Hmm....little bit shorter than mine Trevor !!

 

[Trevor G]

I suppose it is, but both work Michael...

Have a good weekend ..

 

[lavppp]

Thank you for your help. Works just fine now.