update file list code for excel 2007

[answer33]

I just switch from Windows XP to Windows 2007 and I'm no longer able to run
this macro.
Can you help me...
Thanks
-----------------------------------------------

Sub ListFiles_01()
'Using FileSearch to list the files in a directory
Dim i As Integer
i = 1
With Application.FileSearch 'This is the problem'
..NewSearch
..LookIn = "C:\"
..Filename = "*.*"
.SearchSubFolders = True
'.SearchFolders = True
..Execute
For i = 1 To .FoundFiles.Count
Range("B" & i + 1).Value = .FoundFiles(i)
Range("C" & i + 1).Value = FileDateTime(.FoundFiles(i))
Range("D" & i + 1).Value = FileLen(.FoundFiles(i))
'Range("E" & i + 1).Value = Filename(.FoundFiles(i))
Next


End With


End Sub

 

[Ron de Bruin]

Hi

FileSearch is removed from Office 2007 because there where to many problems.

You can use FSO, you can steal a part of the code here to make your loop
http://www.rondebruin.nl/fso.htm

 

[answer33]

Thanks's Ron, but can you be more specific.
I'm not sure what I'm suppose to paste and where to paste it.

 

[Ron de Bruin]

You can try something like this

Change MyPath and Subfolders

Sub testme()
Get_File_Names_Test _
MyPath:="C:\Users\Ron\test", _
Subfolders:=False, _
ExtStr:="*.xl*"
End Sub

Sub Get_File_Names_Test(MyPath As String, Subfolders As Boolean, ExtStr As String)
Dim Fsbj As Object, RootFolder As Object
Dim SubFolderInRoot As Object, file As Object

Worksheets.Add

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'Create FileSystemObject object
Set Fsbj = CreateObject("Scripting.FileSystemObject")

fnum = 0

'Test if the folder exist and set RootFolder
If Fsbj.FolderExists(MyPath) = False Then
MsgBox MyPath & " doesn't exist"
Exit Sub
End If
Set RootFolder = Fsbj.GetFolder(MyPath)


'Fill the array(myFiles)with the list of Excel files in the folder(s)
'Loop through the files in the RootFolder
For Each file In RootFolder.Files
If LCase(file.Name) Like LCase(ExtStr) Then
fnum = fnum + 1
Cells(fnum, 1) = MyPath & file.Name
Cells(fnum, 2) = FileDateTime(MyPath & file.Name)
Cells(fnum, 3) = FileLen(MyPath & file.Name)
End If
Next file

'Loop through the files in the Sub Folders if SubFolders = True
If Subfolders = True Then
For Each SubFolderInRoot In RootFolder.Subfolders
For Each file In SubFolderInRoot.Files
If LCase(file.Name) Like LCase(ExtStr) Then
fnum = fnum + 1
Cells(fnum, 1) = MyPath & SubFolderInRoot & "\" & file.Name
Cells(fnum, 2) = FileDateTime(SubFolderInRoot & "\" & file.Name)
Cells(fnum, 3) = FileLen(SubFolderInRoot & "\" & file.Name)
End If
Next file
Next SubFolderInRoot
End If

'If there are no files in the folder display a msgbox
If fnum = 0 Then
MsgBox "There are no " & ExtStr & " files in this folder"
Else

End If
End Sub

 

[answer33]

Thank's a lot Ron,

It works perfeclty!
Have a nice day

 

[Martin Brown]

Hi

FileSearch is removed from Office 2007 because there where to many problems.

Although not from the help system where it still claims to exist

This disaster area claimed as runtime error 5111 is sort of documented
in the KB
http://support.microsoft.com/kb/920229/en-us

Under XP SP2 here it actually dies with runtime 445 - object does not
support this function.

Although their suggested alternative by a scripted bodge method is too
gruesome to contemplate seriously.
Why did they break such a useful general filesearch function?

You can use FSO, you can steal a part of the code here to make your loophttp://www.rondebruin.nl/fso.htm

Thanks for this tip. It should be incorporated into the KB.

Regards,
Martin Brown