Problem with a function to list files sometimes returning multiple/duplicate results

[Bill_the_Bear]

Hi everyone,

I have a question relating to an older thread, didn't want to necro it so here is the relevant post:

Here is a new version of FindFile, which is far more solid, reliable and easy to use than the previous one posted earlier, as it doesn't rely on the Dir function. Please replace the previous code with this one.

Please read the instructions on how to use it in the beginning of the code.

[FONT=Consolas][SIZE=2][COLOR=Navy]Option Explicit

[COLOR=Green]'*
'* Properties that will be collected for each found file
'*[/COLOR]
Type FoundFileInfo
    sPath As String
    sName As String
End Type

Function FindFiles(ByVal sPath As String, _
    ByRef recFoundFiles() As FoundFileInfo, _
    ByRef iFilesFound As Integer, _
    Optional ByVal sFileSpec As String = "*.*", _
    Optional ByVal blIncludeSubFolders As Boolean = False) As Boolean
[COLOR=Green]'
' FindFiles
' ---------
' Finds all files matching the specified file spec starting from the specified path and
' searches sub-folders if required.
'
' Parameters
' ----------
' sPath (String): Start-up folder, e.g. "C:\Users\Username\Documents"
'
' recFoundFiles (User-defined data type): a user-defined dynamic array to store the path
' and name of found files. The dimension of this array is (1 To nnn), where nnn is the
' number of found files. The elements of this array are:
'   .sPath (String) = File path
'   .sName (String) = File name
'
' iFilesFound (Integer): Number of files found.
'
' sFileSpec (String): Optional parameter with default value = "*.*"
'
' blIncludeSubFolders (Boolean): Optional parameter with default value = False
'   (which means sub-folders will not be searched)
'
' Return values
' -------------
' True: One or more files found, therefore
'   recFoundFiles = Array of paths and names of all found files
'   iFilesFound = Number of found files
' False: No files found, therefore
'   iFilesFound = 0
'
' Using the function (sample code)
' --------------------------------
'    Dim iFilesNum As Integer
'    Dim iCount As Integer
'    Dim recMyFiles() As FoundFileInfo
'    Dim blFilesFound As Boolean
'
'    blFilesFound = FindFiles("C:\Users\MBA\Desktop", _
'        recMyFiles, iFilesNum, "*.txt?", True)
'    If blFilesFound Then
'        For iCount = 1 To iFilesNum
'            With recMyFiles(iCount)
'                MsgBox "Path:" & vbTab & .sPath & _
'                    vbNewLine & "Name:" & vbTab & .sName, _
'                    vbInformation, "Found Files"
'            End With
'        Next
'    Else
'        MsgBox "No file(s) found matching the specified file spec.", _
'            vbInformation, "File(s) not Found"
'    End If
'
'
' Constructive comments and Reporting of bugs would be appreciated.
'[/COLOR]

    Dim iCount As Integer           [COLOR=Green]'* Multipurpose counter[/COLOR]
    Dim sFileName As String         [COLOR=Green]'* Found file name[/COLOR]
[COLOR=Green]   '*
    '* FileSystem objects[/COLOR]
    Dim oFileSystem As Object, _
        oParentFolder As Object, _
        oFolder As Object, _
        oFile As Object

    Set oFileSystem = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    Set oParentFolder = oFileSystem.GetFolder(sPath)
    If oParentFolder Is Nothing Then
        FindFiles = False
        On Error GoTo 0
        Set oParentFolder = Nothing
        Set oFileSystem = Nothing
        Exit Function
    End If
    sPath = IIf(Right(sPath, 1) = "\", sPath, sPath & "\")
[COLOR=Green]   '*
    '* Find files[/COLOR]
    sFileName = Dir(sPath & sFileSpec, vbNormal)
    If sFileName <> "" Then
        For Each oFile In oParentFolder.Files
            If LCase(oFile.Name) Like LCase(sFileSpec) Then
                iCount = UBound(recFoundFiles)
                iCount = iCount + 1
                ReDim Preserve recFoundFiles(1 To iCount)
                With recFoundFiles(iCount)
                    .sPath = sPath
                    .sName = oFile.Name
                End With
            End If
        Next oFile
        Set oFile = Nothing         [COLOR=Green]'* Although it is nothing[/COLOR]
    End If
    If blIncludeSubFolders Then
[COLOR=Green]       '*
        '* Select next sub-forbers[/COLOR]
        For Each oFolder In oParentFolder.SubFolders
            FindFiles oFolder.Path, recFoundFiles, iFilesFound, sFileSpec, blIncludeSubFolders
        Next
    End If
    FindFiles = UBound(recFoundFiles) > 0
    iFilesFound = UBound(recFoundFiles)
    On Error GoTo 0
[COLOR=Green]   '*
    '* Clean-up[/COLOR]
    Set oFolder = Nothing           [COLOR=Green]'* Although it is nothing[/COLOR]
    Set oParentFolder = Nothing
    Set oFileSystem = Nothing

End Function[/COLOR][/SIZE][/FONT]

Thank you to Mohammad Basem for posting this code, I've used it to list all files in a specified folder (and its subfolders). However, I am observing an odd effect I cannot figure out.

Sometimes when the function is run it will find some integer multiple of the number of files. So for example, I ran the function on one folder where I know that there are 86 files in the folder and subfolders. Sometimes the function correctly returns 86 files found, but on other occasions it would return 172 or occasionally 258. Running it multiple times in a row can produce a different result each time with no pattern I can immediately see.

This isn't totally game breaking for me because what I am doing is searching the returned list of files for some specific names, and where there are duplicates (I expect duplicates even when the correct number of files are found) I ask the user via a userform to identify the correct file. So having *extra* duplicates isn't an issue in theory, but it does look very strange for my users when every few times they run the macro a different number of files are returned. It also creates some ambiguity on what action the user should take when the userform presents them a choice of two files, both of which have the same name and location (or worse nine files consisting of three sets of the same three files!). It creates a bit of a "huh?" moment. In reality it makes no difference which you select in this situation but I don't want to be confusing them.

I suppose I could add in some kind of clean up function that spots when the function finds a file that matches a previous file in name and location, and discards that result, but ideally I'd like to understand what is going wrong with the original code that causes it to seemingly list files multiple times.

One fact that may or may not be influencing this is that the folder locations are on a network...?

Thanks for any help with this!
Bear

 

[ChrisM]

What I'm seeing is the function never clears/resets the recFoundFiles variable. Since it's being passed ByRef I think every time you run the function again it is just adding the same files over and over. I'm self-taught so I could be wrong, but I don't see why the function is written this way. Instead of returning True/False, there's no reason why the function can't return a 2-d array of the found files. You test the array and if it's empty then there are no found files. That way you get away from these weird byval - byref issues.

I would rewrite the function, but you can try this, it MIGHT work:

....
....
'* Find files
    Erase recFoundFiles
    sFileName = Dir(sPath & sFileSpec, vbNormal)
...
...

 

[Bill_the_Bear]

Thanks Chris I gave this a go, unfortunately it didn't work, though it did help me understand the function a bit better (the problem behind the problem being I don't understand the function I'm using because I'm a very casual user of VBA).

Anyway, erasing recFoundFiles causes most of the files I'm looking for to fail to be located since it needs to remember the contents of the array as near the end of the function there is this bit:

    If blIncludeSubFolders Then
        '*
        '* Select next sub-forbers
        For Each oFolder In oParentFolder.SubFolders
            FindFiles oFolder.Path, recFoundFiles, iFilesFound, sFileSpec, blIncludeSubFolders
        Next
    End If
    FindFiles = UBound(recFoundFiles) > 0
    iFilesFound = UBound(recFoundFiles)
    On Error GoTo 0

Where it moves on to the next sub folder.

I'm wondering if the fault isn't with the function, but maybe how I call it? Perhaps you could help me understand something. As I understand it when I'm testing things if I hit the "reset" button and then start the macro over no variables should remember their previous values so I should always get the same result (86 files found). I do not always get the same result.

I'm thinking this is a clue!

The procedure I use to trigger the function is:

Sub proLocateAllFiles()
    'Find files
    blFilesFound = FindFiles("***some network location***", recMyFiles, iFilesNum, "*.*", True)
    'Report how many files found in total
    If blFilesFound Then
        MsgBox "Found " & iFilesNum & " files in the specified folder and sub folders."
    Else
        MsgBox "No file(s) found matching the specified file spec.", vbInformation, "File(s) not Found"
        End
    End If
End Sub

Thanks again!

 

[ChrisM]

Oops, I missed the part near the bottom where the function calls itself as it loops through all the various subfolders. I'm not good with recursive procedures, especially ones that are using ByRef variables. I'll defer to the experts to see if they can solve this for you.

As far as the code you are using to call the function, nothing wrong with that, that's the normal way to do it.