Why does this file-listing module produce duplicates?

[GlobeTrotter]

I cannot seem to find the logical error in this module that causes it to duplicate some files. The functions can take in a folder name and output an array of strings representing the files in the folder, or just the directories. Under my current implmentation, I have to parse through and remove duplicates with a seperate function, but that takes a lot of time for large folders.

If anyone can help my figure out the logical error with my recursion, I'd appreciate it. As well, please to reccomend and ways to optimize this code as it takes a while to run.

code:

Option Explicit 'Public Const MAX_PATH = 260 Private Const ERROR_NO_MORE_FILES = 18 Private Const FILE_ATTRIBUTE_DIRECTORY = &H10 Private Const FILE_ATTRIBUTE_NORMAL = &H80 Private Const FILE_ATTRIBUTE_HIDDEN = &H2 Private Const FILE_ATTRIBUTE_SYSTEM = &H4 Private Const FILE_ATTRIBUTE_TEMPORARY = &H100 Private Type FILETIME     dwLowDateTime As Long     dwHighDateTime As Long End Type Private Type WIN32_FIND_DATA     dwFileAttributes As Long     ftCreationTime As FILETIME     ftLastAccessTime As FILETIME     ftLastWriteTime As FILETIME     nFileSizeHigh As Long     nFileSizeLow As Long     dwReserved0 As Long     dwReserved1 As Long     cFileName As String * MAX_PATH     cAlternate As String * 14 End Type Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _     (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _     (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long Private Function StripTerminator(ByVal strString As String) As String     Dim intZeroPos As Integer     intZeroPos = InStr(strString, Chr$(0))     If intZeroPos > 0 Then         StripTerminator = Left$(strString, intZeroPos - 1)     Else         StripTerminator = strString     End If End Function Private Function ListFilesNoDepth(ByVal sStartDir As String) As String()     Dim strFileArray() As String     Dim lpFindFileData As WIN32_FIND_DATA, lFileHdl  As Long     Dim sTemp As String, sTemp2 As String, lRet As Long, iLastIndex  As Integer     Dim strPath As String         On Error Resume Next         '// add trailing \ to start directory if required     If Right$(sStartDir, 1) <> "\" Then sStartDir = sStartDir & "\"     sStartDir = sStartDir & "*.*"         '// get a file handle     lFileHdl = FindFirstFile(sStartDir, lpFindFileData)         If lFileHdl <> -1 Then         Do Until lRet = ERROR_NO_MORE_FILES             strPath = Left$(sStartDir, Len(sStartDir) - 4) & "\"             '// if it is a file             If (lpFindFileData.dwFileAttributes And vbDirectory) <> FILE_ATTRIBUTE_DIRECTORY Then                 sTemp = StrConv(Left$(sStartDir, Len(sStartDir) - 3) & StripTerminator(lpFindFileData.cFileName), vbLowerCase)                 Call strArrayAdd(strFileArray, sTemp)             End If             '// based on the file handle iterate through all files and dirs             lRet = FindNextFile(lFileHdl, lpFindFileData)             If lRet = 0 Then Exit Do         Loop     End If     '// close the file handle     lRet = FindClose(lFileHdl)         ListFilesNoDepth = strFileArray End Function Private Function ListDirsNoDepth(ByVal sStartDir As String) As String()     Dim strFolderArray() As String     Dim lpFindFileData As WIN32_FIND_DATA, lFileHdl  As Long     Dim sTemp As String, sTemp2 As String, lRet As Long, iLastIndex  As Integer     Dim strPath As String         On Error Resume Next         '// add trailing \ to start directory if required     If Right$(sStartDir, 1) <> "\" Then sStartDir = sStartDir & "\"     sStartDir = sStartDir & "*.*"         '// get a file handle     lFileHdl = FindFirstFile(sStartDir, lpFindFileData)         If lFileHdl <> -1 Then         Do Until lRet = ERROR_NO_MORE_FILES             strPath = Left$(sStartDir, Len(sStartDir) - 4) & "\"             '// if it is a directory             If (lpFindFileData.dwFileAttributes And vbDirectory) = FILE_ATTRIBUTE_DIRECTORY Then                 'Strip off null chars and format the string                 sTemp = StrConv(Left$(sStartDir, Len(sStartDir) - 3) & StripTerminator(lpFindFileData.cFileName), vbLowerCase)                 ' make sure it is not a reference                 If InStr(sTemp, ".") = 0 Then                     'add it to the tree view. Store its path as its Key                     Call strArrayAdd(strFolderArray, sTemp)                 End If             End If             '// based on the file handle iterate through all files and dirs             lRet = FindNextFile(lFileHdl, lpFindFileData)             If lRet = 0 Then Exit Do         Loop     End If     '// close the file handle     lRet = FindClose(lFileHdl)         ListDirsNoDepth = strFolderArray End Function Public Function ListFiles(ByVal strStartDir As String, boDepth As Boolean) As String()     Dim strFiles() As String     Dim strDirs() As String     Dim lCount As Long         If Not boDepth Then         strFiles = ListFilesNoDepth(strStartDir)     Else         strDirs = ListDirsNoDepth(strStartDir)         If strFixedUBound(strDirs) = -1 Then             strFiles = ListFilesNoDepth(strStartDir)         Else             For lCount = 0 To strFixedUBound(strDirs)                                 Call strArrayAddArray(strFiles, ListFilesNoDepth(strDirs(lCount)))                 Call strArrayAddArray(strFiles, ListFiles(strDirs(lCount), boDepth))             Next lCount         End If     End If         ListFiles = strFiles End Function Public Function ListDirs(ByVal strStartDir As String, boDepth As Boolean) As String()     Dim strDirs() As String     Dim lCount As Long         If Not boDepth Then         strDirs = ListDirsNoDepth(strStartDir)     Else         strDirs = ListDirsNoDepth(strStartDir)         For lCount = 0 To strFixedUBound(strDirs)             Call strArrayAddArray(strDirs, ListDirs(strDirs(lCount), boDepth))         Next lCount     End If         ListDirs = strArrayRemoveDupes(strDirs) End Function

[Brightguy]

Well you didn't post your strArrayAdd procedure, but I substituted in array resizing and your NoDepth functions seem to work fine.

[GlobeTrotter]

My bad on not posting the helper functions.

Try running this program: See what the result is.

It compares the UBound of the file list, compared with the UBound of the file list (after removing duplicates).

code:

Option Explicit Public Const MAX_PATH = 260 Private Const ERROR_NO_MORE_FILES = 18 Private Const FILE_ATTRIBUTE_DIRECTORY = &H10 Private Const FILE_ATTRIBUTE_NORMAL = &H80 Private Const FILE_ATTRIBUTE_HIDDEN = &H2 Private Const FILE_ATTRIBUTE_SYSTEM = &H4 Private Const FILE_ATTRIBUTE_TEMPORARY = &H100 Private Type FILETIME     dwLowDateTime As Long     dwHighDateTime As Long End Type Private Type WIN32_FIND_DATA     dwFileAttributes As Long     ftCreationTime As FILETIME     ftLastAccessTime As FILETIME     ftLastWriteTime As FILETIME     nFileSizeHigh As Long     nFileSizeLow As Long     dwReserved0 As Long     dwReserved1 As Long     cFileName As String * MAX_PATH     cAlternate As String * 14 End Type Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _     (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _     (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long Public Function strArrayRemoveDupes(strArray() As String) As String()     Dim arrResult() As String     Dim lCount1 As Long     Dim lCount2 As Long         Dim tempBool As Boolean         For lCount1 = 0 To strFixedUBound(strArray)         tempBool = True         For lCount2 = lCount1 To strFixedUBound(strArray)             If lCount1 <> lCount2 And strArray(lCount1) = strArray(lCount2) Then                 tempBool = False             End If         Next lCount2                 If tempBool Then             Call strArrayAdd(arrResult, strArray(lCount1))         End If     Next lCount1         strArrayRemoveDupes = arrResult End Function Private Function StripTerminator(ByVal strString As String) As String     Dim intZeroPos As Integer     intZeroPos = InStr(strString, Chr$(0))     If intZeroPos > 0 Then         StripTerminator = Left$(strString, intZeroPos - 1)     Else         StripTerminator = strString     End If End Function Private Function ListFilesNoDepth(ByVal sStartDir As String) As String()     Dim strFileArray() As String     Dim lpFindFileData As WIN32_FIND_DATA, lFileHdl  As Long     Dim sTemp As String, sTemp2 As String, lRet As Long, iLastIndex  As Integer     Dim strPath As String         On Error Resume Next         '// add trailing \ to start directory if required     If Right$(sStartDir, 1) <> "\" Then sStartDir = sStartDir & "\"     sStartDir = sStartDir & "*.*"         '// get a file handle     lFileHdl = FindFirstFile(sStartDir, lpFindFileData)         If lFileHdl <> -1 Then         Do Until lRet = ERROR_NO_MORE_FILES             strPath = Left$(sStartDir, Len(sStartDir) - 4) & "\"             '// if it is a file             If (lpFindFileData.dwFileAttributes And vbDirectory) <> FILE_ATTRIBUTE_DIRECTORY Then                 sTemp = StrConv(Left$(sStartDir, Len(sStartDir) - 3) & StripTerminator(lpFindFileData.cFileName), vbLowerCase)                 Call strArrayAdd(strFileArray, sTemp)             End If             '// based on the file handle iterate through all files and dirs             lRet = FindNextFile(lFileHdl, lpFindFileData)             If lRet = 0 Then Exit Do         Loop     End If     '// close the file handle     lRet = FindClose(lFileHdl)         ListFilesNoDepth = strFileArray End Function Private Function ListDirsNoDepth(ByVal sStartDir As String) As String()     Dim strFolderArray() As String     Dim lpFindFileData As WIN32_FIND_DATA, lFileHdl  As Long     Dim sTemp As String, sTemp2 As String, lRet As Long, iLastIndex  As Integer     Dim strPath As String         On Error Resume Next         '// add trailing \ to start directory if required     If Right$(sStartDir, 1) <> "\" Then sStartDir = sStartDir & "\"     sStartDir = sStartDir & "*.*"         '// get a file handle     lFileHdl = FindFirstFile(sStartDir, lpFindFileData)         If lFileHdl <> -1 Then         Do Until lRet = ERROR_NO_MORE_FILES             strPath = Left$(sStartDir, Len(sStartDir) - 4) & "\"             '// if it is a directory             If (lpFindFileData.dwFileAttributes And vbDirectory) = FILE_ATTRIBUTE_DIRECTORY Then                 'Strip off null chars and format the string                 sTemp = StrConv(Left$(sStartDir, Len(sStartDir) - 3) & StripTerminator(lpFindFileData.cFileName), vbLowerCase)                 ' make sure it is not a reference                 If InStr(sTemp, ".") = 0 Then                     'add it to the tree view. Store its path as its Key                     Call strArrayAdd(strFolderArray, sTemp)                 End If             End If             '// based on the file handle iterate through all files and dirs             lRet = FindNextFile(lFileHdl, lpFindFileData)             If lRet = 0 Then Exit Do         Loop     End If     '// close the file handle     lRet = FindClose(lFileHdl)         ListDirsNoDepth = strFolderArray End Function Public Function ListFiles(ByVal strStartDir As String, boDepth As Boolean) As String()     Dim strFiles() As String     Dim strDirs() As String     Dim lCount As Long         If Not boDepth Then         strFiles = ListFilesNoDepth(strStartDir)     Else         strDirs = ListDirsNoDepth(strStartDir)         If strFixedUBound(strDirs) = -1 Then             strFiles = ListFilesNoDepth(strStartDir)         Else             For lCount = 0 To strFixedUBound(strDirs)                                 Call strArrayAddArray(strFiles, ListFilesNoDepth(strDirs(lCount)))                 Call strArrayAddArray(strFiles, ListFiles(strDirs(lCount), boDepth))             Next lCount         End If     End If         ListFiles = strFiles End Function Public Function ListDirs(ByVal strStartDir As String, boDepth As Boolean) As String()     Dim strDirs() As String     Dim lCount As Long         If Not boDepth Then         strDirs = ListDirsNoDepth(strStartDir)     Else         strDirs = ListDirsNoDepth(strStartDir)         For lCount = 0 To strFixedUBound(strDirs)             Call strArrayAddArray(strDirs, ListDirs(strDirs(lCount), boDepth))         Next lCount     End If         ListDirs = strDirs End Function Public Function isStringArrayEmpty(StringArray() As String) As Boolean     Dim lTemp As Long     On Error Resume Next     lTemp = UBound(StringArray)     isStringArrayEmpty = (Err.Number <> 0) End Function Public Function strFixedUBound(StringArray() As String) As Long     If isStringArrayEmpty(StringArray) Then         strFixedUBound = -1     Else         strFixedUBound = UBound(StringArray)     End If End Function Public Sub strArrayAdd(ByRef strArray() As String, strAdd As String)     If isStringArrayEmpty(strArray) Then         ReDim strArray(0)         strArray(0) = strAdd     Else         ReDim Preserve strArray(UBound(strArray) + 1)         strArray(UBound(strArray)) = strAdd     End If End Sub Public Sub strArrayAddArray(ByRef strArray() As String, strAddArray() As String)     Dim lCount As Long     If isStringArrayEmpty(strArray) Then         strArray = strAddArray     Else         For lCount = 0 To strFixedUBound(strAddArray)             ReDim Preserve strArray(strFixedUBound(strArray) + 1)             strArray(UBound(strArray)) = strAddArray(lCount)         Next lCount     End If End Sub Public Sub main()     Const TEST_DIR = "c:\"     Debug.Assert False     If UBound(ListFiles(TEST_DIR, True)) = UBound(strArrayRemoveDupes(ListFiles(TEST_DIR, True))) Then         Call MsgBox("I'm wrong, my bad")     Else         Call MsgBox("I'm right, it does produce duplicates")     End If End Sub

[Brightguy]

Take a look at your ListFiles function... what you want to do is add in the files from the starting directory and then recursively call the function for each subdirectory.

You add in the files from each subdirectory as well as recursively going through each subdirectory.