SOS on "Application.FileSearch" for Excel 2007

J

jenfui

New Member
Joined
May 6, 2012
Messages
2
Hi all,
Recently my office PC upgrade to from 2003 to 2007 version and this cause one of my Excel tools did not fuction, after serch via online , believe the root cause is due to the Application.FileSearch not longer available for Excel 2007.

Below is the VBA for my working file, any one have idea how to amend for the FileSearch part ? Appreciate if can get help from here.

Set fs = Application.FileSearch
With fs
.LookIn = C:\Users\jenfui\Desktop\Aging report
.SearchSubFolders = True
.fileName = SOA & "*.*"
If .Execute > 0 Then
masterFound = .FoundFiles.Count
ReDim Preserve FileList(1 To .FoundFiles.Count)
For x = 1 To .FoundFiles.Count
FileList(x) = .FoundFiles(x)
Next x
Else
masterFound = 0
End If
End With
Click to expand...
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Sort by date Sort by votes
See if this will help:

Code: 
Sub ListFiles()     'Finds files in specified folder and lists them excluding ThisWorkbook.Name
Dim sPath As String, SName As String
Dim sName1 As String, bFound As Boolean
Dim i As Long, sh As Worksheet
sPath = ThisWorkbook.Path   'Change to path to be searched if other than ThisWorkbook.
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
SName = Dir(sPath & "*.xls")
Do While SName <> ""
sName1 = Left(SName, Len(SName) - 4)
If LCase(SName) <> LCase(ThisWorkbook.Name) Then
    bFound = False
    For Each sh In ThisWorkbook.Worksheets
        If LCase(sName1) = LCase(sh.Name) Then
            bFound = True
            Exit For
        End If
    Next
    If Not bFound Then
        i = i + 1
        With Worksheets("Sheet1")
            .Cells(i, 1) = SName
        End With
    End If
End If
SName = Dir
Loop
End Sub
 
Last edited by a moderator:
Upvote 0
Hi JLGWhiz,

Really thanks for your response on my pose.
The code you give me did not work, maybe I should give u whole code and lets you have a clear picture how come my working file did not work.

Code: 
Sub Disp()

Application.ScreenUpdating = False

Dim DirList As Variant
Dim PresentDir As String
Dim FileList() As Variant
Dim fileName() As Variant
Dim BaseDir As String
Dim ExtractFile As String
Dim CurFile As String
Dim PolHolder As String
Dim Results(24) As Double
Dim AgeDay As Integer

On Error Resume Next

'----- Clear Report Sheet ---------------------------------------
If Sheets("Settings").Range("ClearRep").value = "Prompt" Then
    ClearInd = MsgBox("Clear Report ?", vbYesNo, "Clear Report")
    If ClearInd = vbYes Then
        ClearReport
    End If
ElseIf Sheets("Settings").Range("ClearRep").value = "Yes" Then
    ClearReport
End If
'----------------------------------------------------------------

'----- Clear Summary Sheet --------------------------------------
If Sheets("Settings").Range("ClearSum").value = "Prompt" Then
    ClearInd = MsgBox("Clear Summary ?", vbYesNo, "Clear Summary")
    If ClearInd = vbYes Then
        ClearOutput
    End If
ElseIf Sheets("Settings").Range("ClearSum").value = "Yes" Then
    ClearOutput
End If
'----------------------------------------------------------------

'----- Main Extraction Code -------------------------------------
StartDate = Sheets("Settings").Range("StartDate").value
BaseDir = Sheets("Settings").Range("BaseDir").value
ExtractFile = Sheets("Settings").Range("ExtractFile").value

DirList = GetFileList(BaseDir & "\*", vbDirectory)
i2 = 0
'Loop through all directory
For i = LBound(DirList) To UBound(DirList)
    
    Attr = GetAttr(BaseDir & "\" & DirList(i))

    If DirList(i) <> "." And DirList(i) <> ".." _
     And Attr <> vbArchive _
     And Attr <> vbNormal Then

        i2 = i2 + 1
        Sheets("Output").Cells(i2 + 5, 1).value = DirList(i)
        Sheets("Report").Cells(i2 + 3, 1).value = i2
        Sheets("Report").Cells(i2 + 3, 2).value = DirList(i)
        For z = 1 To 24
            Results(z) = 0
        Next
        PresentDir = DirList(i)
          
        '~~~ Look within all subfolders in directory ~~~
        Set fs = Application.FileSearch
        With fs
            .LookIn = BaseDir & "\" & PresentDir & "\"
            .SearchSubFolders = True
            .fileName = ExtractFile & "*.*"
            If .Execute > 0 Then
                masterFound = .FoundFiles.Count
                ReDim Preserve FileList(1 To .FoundFiles.Count)
                For x = 1 To .FoundFiles.Count
                    FileList(x) = .FoundFiles(x)
                Next x
            Else
                masterFound = 0
            End If
        End With
        
        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            
        For j = 1 To masterFound
            CurFile = FileList(j)
            CurFileName = ShowFileName(CurFile)
                
            MasterModifiedDate = ShowFileModifiedInfo(CurFile)
            
            'Open Workbook
            Workbooks.Open CurFile, 0, True
            
            If DoesSheetExists("Client") Then
                Sheets("Client").Activate

                '~~~ Search through sheet ~~~
                x = Cells.Find(What:="?*/?*/????", After:=ActiveCell, SearchDirection:=xlNext).Activate

                If x Then
                    StartAddr = ActiveCell.Address
                    Do
                        AgeDay = Max(0, StartDate - ActiveCell.value)
                        Results(Min(Int(Max(0, AgeDay - 1) / 30) + 1, 12)) = Results(Min(Int(Max(0, AgeDay - 1) / 30) + 1, 12)) + _
                            Cells(ActiveCell.Row, ActiveCell.Column + 6).value
                        Results(Min(Int(Max(0, AgeDay - 1) / 30) + 1, 12) + 12) = Results(Min(Int(Max(0, AgeDay - 1) / 30) + 1, 12) + 12) + _
                            Cells(ActiveCell.Row, ActiveCell.Column + 7).value
                        x = Cells.Find(What:="?*/?*/????", After:=ActiveCell, SearchDirection:=xlNext).Activate
                    Loop While x And ActiveCell.Address <> StartAddr
                End If
                '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

            
            End If

            Workbooks(CurFileName).Close False
                
        Next j
        
        If masterFound = 1 Then
            Sheets("Report").Cells(i2 + 3, 3).value = "Y"
            Sheets("Report").Cells(i2 + 3, 4).value = MasterModifiedDate
        ElseIf masterFound > 1 Then
            Sheets("Report").Cells(i2 + 3, 3).value = masterFound
        Else
            Sheets("Report").Cells(i2 + 3, 3).value = "N"
        End If
        
        For i3 = 1 To 12
            Sheets("Output").Activate
            Cells(i2 + 5, i3 + 1).value = Results(i3)
            Cells(i2 + 5, i3 + 14).value = Results(i3 + 12)
            Cells(i2 + 5, 27).value = "=SUM(RC[-25]:RC[-14])-SUM(RC[-12]:RC[-1])"
            Cells(i2 + 5, 28).value = "=IF(SUM(RC[-26]:RC[-21])>=RC[-1],""Y"",""N"")"
            Cells(i2 + 5, 29).value = "=IF(SUM(RC[-27]:RC[-18])>=RC[-2],""Y"",""N"")"
        Next
        
        End If
    Next i

End Sub

From above VBA code, my understanding is , due to the Application.FileSearch did not work, this cause the masterFound = 0 !! and subsequently make the "For j = 1 To masterFound" did not take place and whole calculation did not work.

Any idea how to overcome this?
Lets me know anytime if you need any clarification from me.
 
Last edited by a moderator:
Upvote 0
Hi jenfui and welcome to the forum!

You are right, Application.FileSearch has been deprecated in Excel 2007 without replacement.

One alternative would be using the VBScript FileSystemObject (FSO). Unfortunately, this object is not capable of handling wildcards, therefore a combination of the FSO methods/properties in addition to the Dir() function will simulate the deprecated Application.FileSearch.

Have a look at the below threads. Both handle recursive folder access.

VBA code to open, remove autofilter, save and close multiple files in same directory

Sensing files in a directory
 
Upvote 0
Mohammad Basem said:
Hi jenfui and welcome to the forum!

You are right, Application.FileSearch has been deprecated in Excel 2007 without replacement.

One alternative would be using the VBScript FileSystemObject (FSO). Unfortunately, this object is not capable of handling wildcards, therefore a combination of the FSO methods/properties in addition to the Dir() function will simulate the deprecated Application.FileSearch.

Have a look at the below threads. Both handle recursive folder access.

VBA code to open, remove autofilter, save and close multiple files in same directory

Sensing files in a directory
Click to expand...



This code will count the number of files in a directory. This particular code looks for .xls* extensions but you can change that to look for whatever type files you want, or just use the "*.*" wildcard to look for any file of any type. I believe you can adapt this to do what the fileSearch was doing before.

Code: 
Sub CountFiles()     'Finds files in specified folder and Counts them
Dim sPath As String, SName As String, fDir() As Variant
Dim sName1 As String
Dim i As Long
sPath = ThisWorkbook.Path   'Change to path to be searched if other than ThisWorkbook.
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
SName = Dir(sPath & "*.xls*")
Do While SName <> ""
sName1 = Left(SName, InStr(SName, ".") - 1)
i = i + 1
ReDim Preserve fDir(1 To i)
fDir(i) = sName1
SName = Dir
Loop
MsgBox UBound(fDir)
End Sub
 
Last edited by a moderator:
Upvote 0
Maybe something like this, which gives you the option to include/exclude subfolders...

Code: 
[font=Courier New][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] ListFiles()

    [color=darkblue]Dim[/color] objFSO [color=darkblue]As[/color] [color=darkblue]Object[/color]
    [color=darkblue]Dim[/color] FileList() [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] FileCnt [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    [color=darkblue]Set[/color] objFSO = CreateObject("Scripting.FileSystem[color=darkblue]Object[/color]")
    
    [color=darkblue]Call[/color] RecursiveFolder(objFSO, "C:\Users\jenfui\Desktop\Aging report", FileList(), FileCnt, [color=darkblue]True[/color]) [color=green]'True to include subfolders, False to exclude subfolders[/color]
    
    [color=darkblue]If[/color] FileCnt = 0 [color=darkblue]Then[/color]
        MsgBox "No files were found...", vbInformation
        [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
    [color=darkblue]End[/color] [color=darkblue]If[/color]
    
    [color=green]'etc...[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

Sub RecursiveFolder( _
    [color=darkblue]ByRef[/color] FSO [color=darkblue]As[/color] [color=darkblue]Object[/color], _
    [color=darkblue]ByRef[/color] MyPath [color=darkblue]As[/color] [color=darkblue]String[/color], _
    [color=darkblue]ByRef[/color] MyArray() [color=darkblue]As[/color] [color=darkblue]String[/color], _
    [color=darkblue]ByRef[/color] MyCnt [color=darkblue]As[/color] [color=darkblue]Long[/color], _
    [color=darkblue]ByVal[/color] IncludeSubFolders [color=darkblue]As[/color] [color=darkblue]Boolean[/color])

    [color=darkblue]Dim[/color] File [color=darkblue]As[/color] [color=darkblue]Object[/color]
    [color=darkblue]Dim[/color] Folder [color=darkblue]As[/color] [color=darkblue]Object[/color]
    [color=darkblue]Dim[/color] SubFolder [color=darkblue]As[/color] Object
    
    [color=darkblue]Set[/color] Folder = FSO.GetFolder(MyPath)
    
    [color=darkblue]For[/color] [color=darkblue]Each[/color] File [color=darkblue]In[/color] Folder.Files
        [color=darkblue]If[/color] UCase(File.Name) [color=darkblue]Like[/color] "SOA*.*" [color=darkblue]Then[/color]
            MyCnt = MyCnt + 1
            [color=darkblue]ReDim[/color] [color=darkblue]Preserve[/color] MyArray(1 [color=darkblue]To[/color] MyCnt)
            MyArray(MyCnt) = File.Name
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] File
    
    [color=darkblue]If[/color] IncludeSubFolders [color=darkblue]Then[/color]
        [color=darkblue]For[/color] [color=darkblue]Each[/color] SubFolder [color=darkblue]In[/color] Folder.SubFolders
            [color=darkblue]Call[/color] RecursiveFolder(FSO, [color=darkblue]Sub[/color]Folder.Path, MyArray(), MyCnt, [color=darkblue]True[/color])
        [color=darkblue]Next[/color] SubFolder
    [color=darkblue]End[/color] [color=darkblue]If[/color]
    
[color=darkblue]End[/color] Sub
[/font]
 
Upvote 0
You must log in or register to reply here.

Similar threads

V
  • Question
Set fs = Application.FileSearch doesn't work in newer versions of Excel
Replies
4
Views
3K
Domenic
D
S
  • Question
Set fs = Application.FileSearch 'does not work in 2007
Replies
1
Views
580
Fluff
Fluff
H
  • Question
Excel 2010: VBA How to replace Application.FileSearch
Replies
0
Views
2K
Hitchy
H
A
  • Question
Search and open word file based on excel cell value
Replies
0
Views
328
alattiaa
A
S
  • Question
Excel 2010: VBA replacement for Application.FileSearch
Replies
2
Views
2K
Macropod
Macropod

Forum statistics

Threads
1,216,084
Messages
6,128,722
Members
449,465
Latest member
TAKLAM

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top