Excel 2010: VBA replacement for Application.FileSearch

[Shirlynstxf]

Hi I am currently doing a project and I have trouble figuring out the code for application.filesearch for excel 2010. There is an error to the code and I hope someone can provide me a solution to this code . Thank you in advance

ExceStatic x As Integer
    x = x + 1
    Range("j17").Value = x
    End With
        
    
    With Application.FileSearch
        .NewSearch
        .LookIn = fLdr
        .SearchSubFolders = True
        .Filename = y
        Set ws = ThisWorkbook.Worksheets.Add(Sheets(1))
        On Error GoTo 1
        
2:  ws.Name = "File Search Results"
    On Error GoTo 0
        If .Execute() > 0 Then
            For i = 1 To .FoundFiles.Count
                Fil = .FoundFiles(i)
                 'Get file path from file name
                FPath = Left(Fil, Len(Fil) - Len(Split(Fil, "\")(UBound(Split(Fil, "\")))) - 1)
                If Left$(Fil, 1) = Left$(fLdr, 1) Then
                    If CBool(Len(Dir(Fil))) Then
                        z = z + 1
                        ws.Cells(z + 1, 1).Resize(, 4) = _
                        Array(Dir(Fil), _
                        FileLen(Fil) / 1000, _
                        FileDateTime(Fil), _
                        FPath)
                        ws.Hyperlinks.Add Anchor:=ws.Cells(z + 1, 1), _
                        Address:=.FoundFiles(i)
                    End If
                End If
            Next i
        End If
    End With
     
    ActiveWindow.DisplayHeadings = False
     
    With ws
        Rw = .Cells.Rows.Count
        With .[A1:D1]
            .Value = [{"Full Name","Kilobytes","Last Modified", "Path"}]
            .Font.Underline = xlUnderlineStyleSingle
            .EntireColumn.AutoFit
            .HorizontalAlignment = xlCenter
        End With
        .[E1:IV1 ].EntireColumn.Hidden = True
        On Error Resume Next
        Range(Cells(Rw, "A").End(3)(2), Cells(Rw, "A")).EntireRow.Hidden = True
        Range(.[A2 ], Cells(Rw, "C")).Sort [A2 ], xlAscending, Header:=xlNo
    End With
     
    i = i - 1
    If i < 0 Then
    i = 0
    MsgBox i & " items are found!", vbInformation, _
    "Completed! "
    End If
    
    Application.ScreenUpdating = True
    Exit Sub
1:      Application.DisplayAlerts = False
    Worksheets("File Search Results").Delete
    Application.DisplayAlerts = True
    GoTo 2
End Sub

 

[myexcelcraze]

Pls check thoroughly ...

 

[Macropod]

Application.FileSearch has been deprecated since Office 2007 was released way back when. See: https://support.microsoft.com/en-us/kb/920229
For a replacement, download this file by Andreas Killer:
https://dl.dropboxusercontent.com/u/35239054/FileSearch.cls
Then:
• Import it into your project
• Add this line to your declaration
Dim ApplicationFileSearch as New FileSearch
• Change the line
Application.FileSearch
to
ApplicationFileSearch

Your code is ready to run.