Marco Directory Search Problem from excel 2000 to 2007

[Graham182]

Hi i've just upgraded my Excel from 2000 to 2007 and now this macro have stop working


Sub Dirlist()
Dim i As Long
With Application.FileSearch
.NewSearch
' *** Change Folder name to suit ***
.LookIn = "C:\My Documents"
.SearchSubFolders = True

Dir (Folder & "\" & Extension)
.Filename = "*.xls*"
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
Cells(i, 1).Value = Right(.FoundFiles(i), InStr(StrReverse(.FoundFiles(i)), "\") - 1)
Next

End If
End With
End Sub

it stops at 'With Application.FileSearch' and i'm not sure what to put in inorder for it to carry on working
it used to look through all my MyDocuments and pick out any XLS files
can anyone help
Thanks
Graham

 

[Graham182]

Re: Macro Directory Search Problem from excel 2000 to 2007

This being a good idea but my home PC is Excel 200 and Work is 2007?

 

[Jon von der Heyden]

Try;

Public Sub ShowFolderList()
    Dim objFso As Object
    Dim objFile As Object
    Dim objFolder As Object
    Dim objSubfolder As Object
    Dim s As String
     
    Set objFso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFso.GetFolder("C:\")
        
    For Each objFile In objFolder.Files
        s = s & objFile.Name & " (" & objFolder.Name & ")" & vbCr
    Next objFile
        
    For Each objSubfolder In objFolder.SubFolders
        Call ShowSubFolderList(objSubfolder, s)
    Next objSubfolder
        
    Debug.Print s
        
    Set objFile = Nothing
    Set objSubfolder = Nothing
    Set objFso = Nothing
End Sub
    
Private Sub ShowSubFolderList(objFld As Object, s As String)
    Dim objFil As Object
    Dim objSubfld As Object
    Dim arr() As Variant
       
    On Error Resume Next
       
    For Each objFil In objFld.Files
            s = s & objFil.Name & " (" & objFld.Name & ")" & vbCr
    Next objFil
        
    For Each objSubfld In objFld.SubFolders
        Call ShowSubFolderList(objSubfld, s)
    Next objSubfld
        
    Set objFil = Nothing
    Set objSubfld = Nothing
End Sub

 

[Graham182]

Ok i've tried it but nothing has been listed ??

In my old macro it would list the file names in column A
and then it would list the path with a Hyperlink in Column B

Basicly doing the below macro twice one with the filename and one with the path and hyperlink. But because Application.FileSearch has gone this can't be done now?

Sub AddHyperlinks()
Application.ScreenUpdating = False
Set fs = Application.FileSearch
With fs
.NewSearch
.LookIn = "C:\Documents and Settings\User\My Documents"
.SearchSubFolders = True
Dir (Folder & "\" & Extension)
.Filename = ".doc"
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
Range("A" & i).Hyperlinks.Add Anchor:=Range("A" & i), _
Address:=.FoundFiles(i)
Cells(i, 1).Value = Right(.FoundFiles(i), InStr(StrReverse(.FoundFiles(i)), "\") - 1)
Next i
End If
End With
Application.ScreenUpdating = True
End Sub

 

[Norie]

Graham

Can you post the code that isn't working?

PS I don't mean the FileSearch stuff, I mean the code from the links that have been sugggested.