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.

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

As well, these helper functions are neecessary for it to run:

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

[Edited by s_climax on 07-06-2006 at 11:09 PM GMT]

Hi,
quick question. Does the filename include the path? Maybe there's duplicate names without the path?
Kieron


____________________________
Build it better, faster, quicker, easier.. then fix it (non-offical MS mission statement)

It does include the path in the string resulting array.  There are definately duplicates.  When I parse it and remove duplicates, it gives me around half of the files, thus each file is outputted ~2 times instead of 1.

Hi,
I ran this against my windows dir and received no dups. Can you give an example? And also your remove duplicates code?
Kieron


____________________________
Build it better, faster, quicker, easier.. then fix it (non-offical MS mission statement)

I wrote up a quick program and it confirms (at least in my mind) that my original had been producing duplicates.

Whether or not it produce dupes, it is still quite slow.  Any suggestions to speed it up?

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