Found File and >execute method dont work properly

[tresa123]

Hello all,

I have facing a problem where the code which I have written for serching folders for html files works on some machines and not on all.
The code is used is shown below. So, when I tried debugging, it looked like the count of the files returned was zero. So, there is some problem in the Found Files and the execute method being used.
If anyone has an idea please post.

Thanks,
Tresa

Option Explicit
Sub SrchForFiles()
' Searches the selected folders and sub folders for files with the specified
'extension. .xls, .doc, .ppt, etc.
'A new worksheet is produced called "File Search Results". You can click on the link and go directly
'to the file you need.
Dim i As Long, z As Long, Rw As Long
Dim ws As Worksheet
Dim y As Variant
Dim fLdr As String, Fil As String, FPath As String

y = Application.InputBox("Please Enter File Extension", "Info Request")
If y = False And Not TypeName = "String" Then Exit Sub
Application.ScreenUpdating = False
'**********************************************************************
'fLdr = BrowseForFolderShell
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
fLdr = .SelectedItems(1)
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 = "FileSearch 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:=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

Application.ScreenUpdating = True
Exit Sub
1: Application.DisplayAlerts = False
Worksheets("FileSearch Results").Delete
Application.DisplayAlerts = True
Goto 2
End Sub