Folder List

[Cecilkumara Fernando]

Hi to All,
This macro gets the name of the files in a folder "My Documents" to a excel
sheet,
can it be improved/altered to get the name of the sub folders in it?
Regards,
Cecil

Sub FileListing()
Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim a As Long
Dim sOld As String

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder("C:\My Documents")

a = 2
For Each oFile In oFolder.Files
sOld = oFile.Name
Range("A" & a) = sOld
a = a + 1
Next oFile

End Sub

 

[Bob Phillips]

Morning Cecil,

Try this

Option Explicit

Dim oFSO As Object
Dim a As Long

Sub FileListing()
Dim i As Long
Dim oFolder As Object

Set oFSO = CreateObject("Scripting.FileSystemObject")

a = 2

SelectFiles "C:\MyTest" 'Documents"

End Sub

'-----------------------------------------------------------------------
Sub SelectFiles(ByVal sPath)
'-----------------------------------------------------------------------
Dim oFolder As Object
Dim oFldr As Object
Dim oFile As Object
Dim oFiles As Object
Dim sOld As String

Set oFolder = oFSO.GetFolder(sPath)

For Each oFldr In oFolder.subFolders
SelectFiles oFldr.Path
Set oFiles = oFolder.Files
For Each oFile In oFiles
sOld = oFile.Name
Range("A" & a) = sOld
a = a + 1
Next oFile
Next oFldr

End Sub

 

[Cecilkumara Fernando]

Bob,
Thank you very much.
The following macro did it the way I wanted it,
A little point is that it gets the last folder of a tree first (bottom to
top)
Thanks again
Have a nice weekend.
Regards,
Cecil

Option Explicit

Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim sOld As String
Dim a As Long

Sub FileListing()
Set oFSO = CreateObject("Scripting.FileSystemObject")
a = 2
SelectFiles "C:\ABC" 'Documents"
FilesInSFldr
End Sub

'-----------------------------------------------------------------------
Sub SelectFiles(ByVal sPath)
'-----------------------------------------------------------------------
Dim oFldr As Object
Set oFolder = oFSO.GetFolder(sPath)
For Each oFldr In oFolder.subFolders
SelectFiles oFldr.Path
sOld = oFldr.Path
Range("A" & a) = sOld
a = a + 1
Next oFldr
End Sub
Sub FilesInSFldr()
Dim LRow As Integer
Dim i As Long
Dim sFldr As String
LRow = Range("A" & Rows.Count).End(xlUp).Row
With Range("A2:A" & LRow)
.Copy
Range("A1").PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
.ClearContents
End With
For i = 1 To LRow - 1
a = 2
sFldr = Cells(1, i).Value
Set oFolder = oFSO.GetFolder(sFldr)
For Each oFile In oFolder.Files
sOld = oFile.Name
Range(Chr(i + 64) & a) = sOld
a = a + 1
Next oFile
Next i
Cells.EntireColumn.AutoFit
Range("A1").Select
End Sub