update file list code for excel 2007

A

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
 
A

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.
 
R

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 Fso_Obj 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 Fso_Obj = CreateObject("Scripting.FileSystemObject")

fnum = 0

'Test if the folder exist and set RootFolder
If Fso_Obj.FolderExists(MyPath) = False Then
MsgBox MyPath & " doesn't exist"
Exit Sub
End If
Set RootFolder = Fso_Obj.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
 
M

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top