Solved: List File Names

[khalid79m]

Hi can anyone help me retrieve just the file names under the following folder & sub folders

P:\AS\SS\2008\MAY 2008\SR\Batch1

I just want .xls files to be placed on the worksheet "AA" from cell a2 downwards ?


Can any one help ?

[Bob Phillips]

[vba]

Dim oFSO As Object
Dim NextRow As Long

Public Sub LoopFolders()

Set oFSO = CreateObject("Scripting.FileSystemObject")

selectFiles "c:\Test"

Set oFSO = Nothing

End Sub


'---------------------------------------------------------------------------
Private Sub selectFiles(sPath)
'---------------------------------------------------------------------------
Dim Folder As Object
Dim Files As Object
Dim file As Object
Dim fldr

Set Folder = oFSO.GetFolder(sPath)

For Each fldr In Folder.Subfolders
selectFiles fldr.Path
Next fldr

For Each file In Folder.Files

If file.Type Like "*Microsoft Excel*" Then

NextRow = NextRow + 1
ActiveSheet.Cells(NextRow, "A").Value = file.Name
End If
Next file

End Sub
[/vba]

[khalid79m]

Sorry, but I cant get this to work ?? it freezes on
Set Folder = oFSO.GetFolder(sPath) and says object required //

[khalid79m]

Function GetFileList(FileSpec As String) As Variant
'   Returns an array of filenames that match FileSpec
'   If no matching files are found, it returns False
    Dim FileArray() As Variant
    Dim FileCount As Integer
    Dim FileName As String
    
    On Error GoTo NoFilesFound
    FileCount = 0
    FileName = Dir(FileSpec)
    If FileName = "" Then GoTo NoFilesFound
    
'   Loop until no more matching files are found
    Do While FileName <> ""
        FileCount = FileCount + 1
        ReDim Preserve FileArray(1 To FileCount)
        FileArray(FileCount) = FileName
        FileName = Dir()
    Loop
    GetFileList = FileArray
    Exit Function
'   Error handler
NoFilesFound:
    GetFileList = False
End Function
Sub test()
    
    Dim p As String, x As Variant
    p = "P:\CET - Employee Engagement\Sourcing & Monitoring\2008\MAY 2008\SiteReturns\Batch1"
    x = GetFileList(p)
    
    Select Case IsArray(x)
        Case True 'files found
            'MsgBox UBound(x)
            Sheets("Non_Returns_Batch1").Range("A:A").Clear
            For i = LBound(x) To UBound(x)
                Sheets("Non_Returns_Batch1").Cells(i, 1).Value = x(i)
            Next i
        Case False 'no files found
            MsgBox "No matching files"
    
    End Select
End Sub

I Currently have this code, but it doesnt search subfolders ? how can i get it to do this ?

[Bob Phillips]

My code worked here.

[khalid79m]

Ah i figured it out... its working fine.. just one tweek if you can help.. can i get it to start from a3 and work downwards. Because I need to 2 lines for headers and also when I re run it starts from the last entry rather than overwriting the exsisting.

[Bob Phillips]

[vba]

Dim oFSO As Object
Dim NextRow As Long

Public Sub LoopFolders()

NextRow = 2

Set oFSO = CreateObject("Scripting.FileSystemObject")

selectFiles "c:\Test"

Set oFSO = Nothing

End Sub


'---------------------------------------------------------------------------
Private Sub selectFiles(sPath)
'---------------------------------------------------------------------------
Dim Folder As Object
Dim Files As Object
Dim file As Object
Dim fldr

Set Folder = oFSO.GetFolder(sPath)

For Each fldr In Folder.Subfolders
selectFiles fldr.Path
Next fldr

For Each file In Folder.Files

If file.Type Like "*Microsoft Excel*" Then

NextRow = NextRow + 1
ActiveSheet.Cells(NextRow, "A").Value = file.Name
End If
Next file

End Sub
[/vba]

should address both points

[khalid79m]

Just to let you know it works fine.. I need to use this to look at four different paths seperatley.. how can i do this.. if i copy the script and put it into 4 different modules it doesnt seem to work..

[Bob Phillips]

Is this what you mean?

[vba]

Dim oFSO As Object
Dim NextRow As Long

Public Sub LoopFolders()

NextRow = 2

Set oFSO = CreateObject("Scripting.FileSystemObject")

selectFiles "c:\Test"
selectFiles "c:\Alan\Files"
selectFiles "c:\Joe\Files"
selectFiles "c:\Peter\Files"

Set oFSO = Nothing

End Sub


'---------------------------------------------------------------------------
Private Sub selectFiles(sPath)
'---------------------------------------------------------------------------
Dim Folder As Object
Dim Files As Object
Dim file As Object
Dim fldr

Set Folder = oFSO.GetFolder(sPath)

For Each fldr In Folder.Subfolders
selectFiles fldr.Path
Next fldr

For Each file In Folder.Files

If file.Type Like "*Microsoft Excel*" Then

NextRow = NextRow + 1
ActiveSheet.Cells(NextRow, "A").Value = file.Name
End If
Next file

End Sub
[/vba]

[Jan Karel Pieterse]

Just for fun:

Write your directory specification in cell B1:

P:\AS\SS\2008\MAY 2008\SR\Batch1\*.xls

Define a name (Insert, name, define):

Name:ListOfFiles
RefersTo:=FILES($B$1)

Now in cell A1, enter:

=INDEX(ListOfFiles,Row())

copy down.

Warning: do not copy any cell in column A with that formula to another worksheet, or Excel versions previous to Excel XP may crash.

[Bob Phillips]

Cute trick, but doesn't do sub-folders.

[Jan Karel Pieterse]

I know. I did say it was for fun <g>.

[khalid79m]

thanks guys.. perfect