List all files in a sub directory

[KateB]

Hoping someone can help me - it seems that Application.FileSearch no
longer works in Excel 2007. I used to have a routine (below) which
listed all the files in a directory (and possibly sub directory. I
had a dig around on the group last night & I think I need to use fso,
but I'm not exactly sure what that means, or how to implement it. Can
someone help me?

My knowledge of VBA is poor-moderate.

Thanks,
Kate

Sub ListFiles()
Set fs = Application.FileSearch

With fs
.LookIn = ActiveWorkbook.Path
.SearchSubFolders = True
.FileName = "*.*"
If .Execute() > 0 Then
'MsgBox "There were " & .FoundFiles.Count & _
' " file(s) found."
'For I = 1 To .FoundFiles.Count
' MsgBox .FoundFiles(I)
'Next I
Else
MsgBox "There were no files found."
End If

'write headings

Range("A1").Value = "Size (MB)"
Range("B1").Value = "File"
Range("C1").Value = "Date"

For i = 1 To .FoundFiles.Count

Range("B" & i + 1).Value = .FoundFiles(i)
Range("A" & i + 1).Value = FileLen(.FoundFiles(i)) / 1024 ^ 2
Range("C" & i + 1).Value = FileDateTime(.FoundFiles(i))

Next

End With

End Sub

 

[Joel]

Try this

Dim RowNumber
Sub GetFiles()

Range("A1").Value = "Size (MB)"
Range("B1").Value = "File"
Range("C1").Value = "Date"


strFolder = ActiveWorkbook.Path
RowNumber = 1

Set fso = CreateObject _
("Scripting.FileSystemObject")
Set folder = _
fso.GetFolder(strFolder)

RowNumber = RowNumber + RowNumber

Call GetSubFolderSize(strFolder + "\")
End Sub

Sub GetSubFolderSize(strFolder)
Set fso = CreateObject _
("Scripting.FileSystemObject")

Set folder = _
fso.GetFolder(strFolder)

If folder.subfolders.Count > 0 Then
For Each sf In folder.subfolders
On Error GoTo 100
Call GetSubFolderSize(strFolder + sf.Name + "\")
100 Next sf
End If
'folder size in bytes
On Error GoTo 200

For Each MyFile In folder.Files
Range("B" & i + 1).Value = MyFile.Path
Range("A" & i + 1).Value = MyFile.Size / 1024 ^ 2
Range("C" & i + 1).Value = MyFile.Datelastmodified
a = 1
Next MyFile
200 On Error GoTo 0

End Sub

 

[Joel]

I forgot to increment the row number.

Dim RowNumber
Sub GetFiles()

Range("A1").Value = "Size (MB)"
Range("B1").Value = "File"
Range("C1").Value = "Date"


strFolder = ActiveWorkbook.Path
RowNumber = 2

Set fso = CreateObject _
("Scripting.FileSystemObject")
Set folder = _
fso.GetFolder(strFolder)

RowNumber = RowNumber + RowNumber

Call GetSubFolderSize(strFolder + "\")
End Sub

Sub GetSubFolderSize(strFolder)
Set fso = CreateObject _
("Scripting.FileSystemObject")

Set folder = _
fso.GetFolder(strFolder)

If folder.subfolders.Count > 0 Then
For Each sf In folder.subfolders
On Error GoTo 100
Call GetSubFolderSize(strFolder + sf.Name + "\")
100 Next sf
End If
'folder size in bytes
On Error GoTo 200

For Each MyFile In folder.Files
Range("B" & RowNumber).Value = MyFile.Path
Range("A" & RowNumber).Value = MyFile.Size / 1024 ^ 2
Range("C" & RowNumber).Value = MyFile.Datelastmodified
RowNumber = RowNumber + 1
Next MyFile
200 On Error GoTo 0

End Sub

 

[KateB]

Perfect, thanks!

I forgot to increment the row number.

Dim RowNumber
Sub GetFiles()

   Range("A1").Value = "Size (MB)"
   Range("B1").Value = "File"
   Range("C1").Value = "Date"

   strFolder = ActiveWorkbook.Path
   RowNumber = 2

   Set fso = CreateObject _
      ("Scripting.FileSystemObject")
   Set folder = _
      fso.GetFolder(strFolder)

   RowNumber = RowNumber + RowNumber

   Call GetSubFolderSize(strFolder + "\")
End Sub

Sub GetSubFolderSize(strFolder)
   Set fso = CreateObject _
      ("Scripting.FileSystemObject")

   Set folder = _
      fso.GetFolder(strFolder)

      If folder.subfolders.Count > 0 Then
         For Each sf In folder.subfolders
            On Error GoTo 100
            Call GetSubFolderSize(strFolder + sf.Name + "\")
100      Next sf
      End If
   'folder size in bytes
   On Error GoTo 200

   For Each MyFile In folder.Files
      Range("B" & RowNumber).Value = MyFile.Path
      Range("A" & RowNumber).Value = MyFile.Size / 1024 ^ 2
      Range("C" & RowNumber).Value = MyFile.Datelastmodified
    RowNumber = RowNumber + 1
   Next MyFile
200   On Error GoTo 0

End Sub

 

[Jonnie]

Hoping someone can help me - it seems that Application.FileSearch no
longer works in Excel 2007. I used to have a routine (below) which
listed all thefilesin adirectory(and possibly subdirectory.  I
had a dig around on the group last night & I think I need to use fso,
but I'm not exactly sure what that means, or how to implement it.  Can
someone help me?

My knowledge ofVBAis poor-moderate.

Thanks,
Kate

Sub ListFiles()
Set fs = Application.FileSearch

With fs
    .LookIn = ActiveWorkbook.Path
    .SearchSubFolders = True
    .FileName = "*.*"
    If .Execute() > 0 Then
        'MsgBox "There were " & .FoundFiles.Count & _
        ' " file(s) found."
        'For I = 1 To .FoundFiles.Count
        '    MsgBox .FoundFiles(I)
        'Next I
    Else
        MsgBox "There were nofilesfound."
    End If

    'write headings

    Range("A1").Value = "Size (MB)"
    Range("B1").Value = "File"
    Range("C1").Value = "Date"

    For i = 1 To .FoundFiles.Count

        Range("B" & i + 1).Value = .FoundFiles(i)
        Range("A" & i + 1).Value = FileLen(.FoundFiles(i)) / 1024 ^ 2
        Range("C" & i + 1).Value = FileDateTime(.FoundFiles(i))

Next

End With

End Sub

Here is a simple program that I use to list files in a certain
directory!
http://vbaexcel.eu/vba-macro-code/list-files-in-directory