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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.