PDA

View Full Version : Solved: List File Names



khalid79m
06-25-2008, 03:59 AM
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 ?:bug:

Bob Phillips
06-25-2008, 04:11 AM
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

khalid79m
06-25-2008, 04:16 AM
Sorry, but I cant get this to work ?? it freezes on
Set Folder = oFSO.GetFolder(sPath) and says object required //

khalid79m
06-25-2008, 04:18 AM
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
06-25-2008, 04:28 AM
My code worked here.

khalid79m
06-25-2008, 05:46 AM
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.:dunno

Bob Phillips
06-25-2008, 06:04 AM
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


should address both points

khalid79m
06-25-2008, 06:51 AM
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
06-25-2008, 06:58 AM
Is this what you mean?



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

Jan Karel Pieterse
06-25-2008, 07:19 AM
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
06-25-2008, 07:31 AM
Cute trick, but doesn't do sub-folders.

Jan Karel Pieterse
06-25-2008, 09:15 AM
I know. I did say it was for fun <g>.

khalid79m
06-26-2008, 09:40 AM
thanks guys.. perfect