Examine File System For Files With Certain Names 1

[idbr]

Hi,

I'm trying to list Excel files within whose filenames DON'T meet certain criteria. I'm using a recursive process:

Public Sub Loop_SubFolders(strFolder As String)

On Error Resume Next

'Uses recursion to examine file structure
'Starts at fldRoot, works through all subfolders under that folder
'Calls List_Files to output file list

Dim fldRoot As folder
Dim fld As folder
Dim fs As FileSystemObject

'Create a new filesystemobject container
Set fs = New FileSystemObject

'Set the folder to be examined
Set fldRoot = fs.GetFolder(strFolder)

'Loop through the subfolders under this folder
    For Each fld In fldRoot.SubFolders
    
        'List the files in the folder
        Call List_Files(fld)
        
        Debug.Print fld.Path
        
        'Call the process again for easch folder in the subfolder
        Loop_SubFolders fld
        
    Next fld
    
End Sub

Public Sub List_Files(strListFolder As String)

'lists files in strListFolder that meet criteria to a text file

On Error Resume Next

Dim fs As FileSystemObject
Dim fl As File
Dim fld As folder
Dim objFL As Object
Dim objDoc As Document

Set fs = New FileSystemObject

Set fld = fs.GetFolder(strListFolder)

Open "C:\Spreadsheets.txt" For Append As #1

For Each fl In fld.Files

    'Just interested in Spreadsheet files
    If Right(fl.Name, 4) = ".xls" Then
        
        '------------------------------------------
        'Check against the list of names to exclude
        '------------------------------------------
        
        If fl.Name Like "*TextString1ToCheck*" Then
        
            GoTo tagNextFor
            
        ElseIf fl.Name Like "*TextString2ToCheck*" Then
        
            GoTo tagNextFor
            
        ElseIf etc, to string 23...
        
        End If
        
        'No match, output the file path
        Print #1, fl.Path
    
    End If
    
tagNextFor:

Next fl

Close #1

End Sub

This works, but is horrendously slow. I think I'm probably barking up the wrong tree and that there is a simpler and quicker way to go. FYI, the folder I'm interested in contains ~25,000 .xls files %-). Can anyone help??

Thanks, Iain

 

[mp9]

I think you may find a speed hike by removing the following line from Loop_SubFolders

 Debug.Print fld.Path

http://www22.brinkster.com/accessory/

 

[CautionMP]

idbr,
Have you tried [tt]FileSearch[/tt] to see if it runs any faster (this was done in Excel 2000)?

Sub FileSearch(FolderName As String)
On Error GoTo FileSearch_Error
Dim MyFileSearch As FileSearch
Dim MyFile As Variant
Dim MyFileNumber As Integer, MyPathSeperator As Integer
Dim MyPath As String, MyFileName As String
Set MyFileSearch = Application.FileSearch
MyFileNumber = FreeFile
Open "C:\Spreadsheets.txt" For Append As #MyFileNumber
With MyFileSearch
    .NewSearch
    .LookIn = FolderName
    .SearchSubFolders = True
    .FileType = msoConditionFileTypeExcelWorkbooks
    .Execute
    For Each MyFile In MyFileSearch.FoundFiles
      MyPathSeperator = InStrRev(MyFile, "\")
      MyPath = Left(MyFile, MyPathSeperator)
      MyFileName = Mid(MyFile, MyPathSeperator + 1)
      '***Perform you like test here
        Print #MyFileNumber, MyPath
      '***End test
    Next MyFile
End With
Clean_Up:
Close #MyFileNumber
Set MyFile = Nothing
Set MyFileSearch = Nothing
Exit Sub
FileSearch_Error:
Debug.Print Err.Number, Err.Description
Resume Clean_Up
End Sub

Hope this helps,
CMP

(GMT-07:00) Mountain Time (US & Canada)

 

[PHV]

The basic idea is to avoid unnecessary instantations of objects:

Public Sub SearchFolder(strFolder As String)
Dim fs As FileSystemObject
Dim fldRoot As Folder
'Create a new filesystemobject container
Set fs = New FileSystemObject
'Set the folder to be examined
Set fldRoot = fs.GetFolder(strFolder)
Open "C:\Spreadsheets.txt" For Output As #1
Loop_SubFolders fldRoot
Set fldRoot = Nothing
Set fs = Nothing
Close #1
End Sub

Public Sub Loop_SubFolders(fldRoot As Folder)
'Uses recursion to examine file structure
'Starts at fldRoot, works through all subfolders under that folder
'Calls List_Files to output file list
Dim fld As Folder
'Loop through the subfolders under this folder
For Each fld In fldRoot.SubFolders
  'List the files in the folder
  List_Files fld
  'Call the process again for easch folder in the subfolder
  Loop_SubFolders fld
Next fld
End Sub

Public Sub List_Files(fld As Folder)
'lists files in strListFolder that meet criteria to a text file
Dim fl As File
For Each fl In fld.Files
  'Just interested in Spreadsheet files
  If LCase(Right(fl.Name, 4)) = ".xls" Then
    '------------------------------------------
    'Check against the list of names to exclude
    '------------------------------------------
    If fl.Name Like "*TextString1ToCheck*" Then
    ElseIf fl.Name Like "*TextString2ToCheck*" Then
    ElseIf etc, to string 23...
    Else
      'No match, output the file path
      Print #1, fl.path
    End If
  End If
Next fl
End Sub

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[idbr]

All,

To bench test I created a standard structure to play with:

Test-----
|        |
Test1    Test2---------------
           |                 |
         Test3-------      Test4-------
           |         |       |         |
         Test5     Test6   Test7     Test8

Each of the folders contained the same 100 randomly generated single-sheet workbooks. The files were named with a randomly generated string of 20 a-z chars.

Each process was run testing for 10 random two char combinations in the filename.

Results:

idbr: 36s
PHV: 36s
CautionMP: 1s

Interestingly, CautionMP's process outputs 711 lines to the text file, mine 632. The filenames are all valid, non-duplicated and should be included according to the rules of the game. I have no idea why this should happen, any guesses?

Thanks Mr CautionMP, should be a big help.

Cheers, Iain

 

[Remou]

As far as I recall, Application.Filesearch returns shortcuts as files.