Print Results To Excel Worksheet

[richardSmith]

I want to run a recursive file search including sub-folders to print all .xls and .xlsx file names into column A in the workbook I am running this procedure in. can someone show me the vba to do such?

Thank you in advance for your kindness and generosity.

[jo15765]

I got this code from Andrew Poulson over at mrexcel a while back - I can't find the original thread to link back to it :\

Sub ListAllFiles()
Dim fs As FileSearch, ws As Worksheet, i As Long
Dim r As Long
Set fs = Application.FileSearch
With fs
.SearchSubFolders = True '
.FileType = msoFileTypeExcelWorkbooks 'can modify to just Excel files eg with msoFileTypeExcelWorkbooks
.LookIn = "C:\Test"
If .Execute > 0 Then
Set ws = Worksheets.Add
r = 1
For i = 1 To .FoundFiles.Count
If Right(.FoundFiles(i), 3) = ".xls" Or Right(.FoundFiles(i), 4) = ".xlsx" Then
ws.Cells(r, 1) = .FoundFiles(i)
r = r + 1
End If
Next
Else
MsgBox "No files found"
End If
End With
End Sub

[richardSmith]

Thank you @jo15765 When I try to run this code I get a debug error of 'object doesn't support this method' on the line of code

Set fs = Application.Search


I am running excel 2007

[jo15765]

I just googled and found that filesearch is not avaliable for Excel 2007. Not sure of an alternative method. Hrmph.

[jo15765]

Try this

Sub Your_Sub()


Dim FSO as Object
Dim FSO_FOLDER AS Object
Dim FSO_FILE as Object
Dim FILE_PATH as String
Dim FILE_EXT as String


FILE_PATH = "S:\My\File\Path"
FILE_EXT = "xls"


''Create FileSystem Objects
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FSO_FOLDER = FSO.GetFolder(FILE_PATH)


If FSO_FOLDER.Files.Count > 0 Then


''Loop through each File in Folder
For Each FSO_FILE IN FSO_FOLDER.Files


''Test extension
If FSO.GetExtensionName(FSO_FILE.Name) = FILE_EXT Then
''Do your thing here
Else:End if


Next


Else


Msgbox "No Files Found at " & FILE_PATH


End If


Set FSO = Nothing
Set FSO_FOLDER = Nothing


End Sub


http://stackoverflow.com/questions/17671725/application-filesearch-in-excel-2007-w-loop

[richardSmith]

What about writing the found .xls & .xlsx files to the worksheet?

[westconn1]

also the above does not search subfolders

put this for do your thing here

If FSO.GetExtensionName(FSO_FILE.Name) = "xls" or FSO.GetExtensionName(FSO_FILE.Name) = "xlsx" Then
ws.Cells(r, 1) = FSO_FILE.Name
r = r + 1
or to recursive search all subfolders try like

Sub allxls()
Dim fso As FileSystemObject
Dim ws As Worksheet
Set fso = CreateObject("scripting.filesystemobject")
Set ws = ThisWorkbook.Sheets.Add
ws.Name = "mytest2"
searchfolder ws, fso.GetFolder("c:\temp")
End Sub
Sub searchfolder(ws As Worksheet, fol As Folder)
Static rw As Long
Dim fold As Folder
For Each f In fol.Files
If InStr(f.Name, ".xls") > 0 Then ' will find xls and xlsx, but also .xls* like xlsm etc
rw = rw + 1
ws.Cells(rw, 1).Value = f.Name ' change this if you want the path as well
End If
Next
For Each fold In fol.SubFolders
searchfolder ws, fold
Next
End Subreference to fso required, else change all filesystemobject variables to object
if you want to add files to an existing worksheet, you would need to find the last row on the sheet each time you start the procedure, in stead of using a static for worksheet row