Need help unraveling a loop on handeling events....

[JustSomeGuy]

I have a loop that searches a directory and its sub directories for files.
When if finds a file it goes off and processes it. On top of that it's recursive.
I need to break this loop into to functions myfindfirst and myfindnext.

Private Sub FindAllFiles(ByVal startdir As String)

    If aborted Then Exit Sub

    Dim NewDirToSearch As String, FileFound As String
    
    If Right(startdir, 1) <> "\" Then
        startdir = startdir & "\"
    End If

    Dim hFind As Long
    Dim fdata As WIN32_FIND_DATA
    Dim name As String

    hFind = FindFirstFile(startdir & "*.*", fdata)

    If hFind = 0 Then
        Exit Sub ' no files found
    End If

    Do
        FileFound = Left$(fdata.cFileName, InStr(fdata.cFileName, Chr$(0)) - 1)

        If fdata.dwFileAttributes And vbDirectory Then
            If Right(FileFound, 1) <> "." Then
                NewDirToSearch = startdir & FileFound
                FindAllFiles NewDirToSearch
            End If
        Else
            name = Left$(fdata.cFileName, InStr(fdata.cFileName, Chr$(0)) - 1)
            If (Left(name, 1) <> ".") Then
                ProcessAFile startdir & name   'POINT A
                DoEvents
           End If
        End If
        
        DoEvents

    Loop While FindNextFile(hFind, fdata)

    hFind = FindClose(hFind)

End Sub

If there is a simpler way to stop the loop at point 'A' and wait for a button to be pressed before going to look for the next file, that might be a solution that doesn't require unlooping this loop.

[dglienna]

Simple way:

 name = Left$(fdata.cFileName, InStr(fdata.cFileName, Chr$(0)) - 1)
            If (Left(name, 1) <> ".") Then
                MSGBOX ("This is POINT A",vbYesNo)
                ProcessAFile startdir & name   'POINT A
                DoEvents
           End If

You could use EXIT LOOP or EXIT SUB/FUNCTION

[JustSomeGuy]

myButton.doModal

Thanks that's a great idea!
De looping that loop was driving me loop de loop.

[rxbagain]

Just want to share my class for recursive file search.

' CRecursiveFind.cls

Option Explicit

Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1&
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 FindNextFile Lib "kernel32" Alias "FindNextFileA" _
   (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindCloseAPI Lib "kernel32" Alias "FindClose" _
   (ByVal hFindFile As Long) As Long

Private hFind As Long
Private strDir As String
Private strMask As String
Private child As CRecursiveFind
Private fdata As WIN32_FIND_DATA

Public Function FindFirst(ByVal startDir As String, ByVal mask As String) As String
   Call FindClose
   strMask = mask
   strDir = startDir & IIf(Right("\" & startDir, 1) <> "\", "\", "")
   hFind = FindFirstFile(strDir & strMask, fdata)
   If (hFind <> INVALID_HANDLE_VALUE) Then FindFirst = DoFind(True)
End Function

Public Function FindNext() As String
   FindNext = DoFind(False)
End Function

Public Sub FindClose()
   Call ResetChild
   If (hFind <> INVALID_HANDLE_VALUE) Then Call FindCloseAPI(hFind)
   hFind = INVALID_HANDLE_VALUE
End Sub

Private Function DoFind(ByVal fFoundByApi As Boolean) As String
   Dim sFile As String, sName As String
   If (fFoundByApi = False) Then
      If (Not child Is Nothing) Then
         sFile = child.FindNext
         If (Len(sFile) = 0) Then Call ResetChild
      End If
      If ((Len(sFile) = 0) And (hFind <> INVALID_HANDLE_VALUE)) Then
         fFoundByApi = FindNextFile(hFind, fdata)
      End If
   End If
   While ((Len(sFile) = 0) And (fFoundByApi = True))
      sName = Left(fdata.cFileName, InStr(fdata.cFileName, Chr(0)) - 1)
      If (Len(Replace(sName, ".", "")) > 0) Then
         sFile = strDir + sName
         If ((fdata.dwFileAttributes And vbDirectory) <> 0) Then
            Set child = New CRecursiveFind
            sFile = child.FindFirst(sFile, strMask)
            If (Len(sFile) = 0) Then Call ResetChild
         End If
      End If
      If (Len(sFile) = 0 And (hFind <> INVALID_HANDLE_VALUE)) Then
         fFoundByApi = FindNextFile(hFind, fdata)
      End If
   Wend
   DoFind = sFile
End Function

Private Sub ResetChild()
   If (Not child Is Nothing) Then
      Call child.FindClose
      Set child = Nothing
   End If
End Sub

Private Sub Class_Initialize()
   hFind = INVALID_HANDLE_VALUE
End Sub

Private Sub Class_Terminate()
   Call FindClose
End Sub

The usage is simple as in this code

Option Explicit

Private Sub Form_Load()
   Dim ff As New CRecursiveFind, sFile As String
   sFile = ff.FindFirst("C:\TEST\VB6APP", "*.*")
   While (Len(sFile))
      Debug.Print sFile
      sFile = ff.FindNext
   Wend
   ff.FindClose
End Sub

[dglienna]

That isn't RECURSIVE.

This is. It multiplies every number, then subtracts 1 and calls ITSELF untill it hits 1 or 0. It fires at least once for any sNum > 1

Option Explicit

Private Sub Form_Load()
   MsgBox Factorial(8)
 End
End Sub
Public Function Factorial(nNum As Integer) As Long
    If nNum = 1 Or nNum = 0 Then
      Factorial = 1
    Else
      Factorial = nNum * Factorial(nNum - 1)
    End If
End Function

[rxbagain]

Maybe my "recursive" term is misleading/wrong since my implementation is not actually recursive. I've seen a lot of console applications using the term "recursive" w/c means it will go through subdirectories so I got into thinking that it's OK to use the word "recursive" even if the code is not implemented as recursive.

Basically what I meant with "recursive" is that it could go deep through the subdirectories of the given folder.

[JustSomeGuy]

I don't know it looks recursive to me...
I mean findnext does call findfirst doesn't it?

[rxbagain]

I don't know it looks recursive to me...
I mean findnext does call findfirst doesn't it?

By definition, recursion means "a function that calls itself". In my code, I moved the main part to "DoFind" so even if it is called by FindNext and it calls FindNext also (in the child class), by definition it is not a recursion.

If you move the DoFind code and place it inside FindNext/FindFirst, I'm not sure but maybe it can be called recursion since the function is actually "itself" even if it is on the "child" class (sFile = child.FindNext).

[WoF]

In a way I do consider the code recursive, only in terms of object orientation:
The code creates a child object of its own and for instance calls child.FindNext. Admittedly it is not the same code in memory which is called recursively, but the same (written) code of the newly created child object, which will create a new child object and call its routines, and so on.
Maybe there is another special term for this, but to me it is kind of a recursion.

[rxbagain]

Maybe we can call it a recursive class

Anyway I just have to add a fix to the code. The code I posted cannot process subdirectories unless the name matches the search patern. To be able to go through all the subdirectories, the code should search for "*" (all files) and we have to perform the filter matching in our code. For ease of coding, I just used VB's "Like" operator. It's simple to use and it supports the '*' and '?' wildcards. An added bonus (or it could also be a limitation ) is that you can add more to your search patern.

Here are the changes I made

Option Compare Text            'case insensitive comparison

...

Public Function FindFirst(ByVal startDir As String, ByVal mask As String) As String
   Call FindClose
   strMask = mask
   strDir = startDir & IIf(Right("\" & startDir, 1) <> "\", "\", "")
   hFind = FindFirstFile(strDir & "*", fdata)
   If (hFind <> INVALID_HANDLE_VALUE) Then FindFirst = DoFind(True)
End Function

Private Function DoFind(ByVal fFoundByApi As Boolean) As String

   ...

      If (Len(Replace(sName, ".", "")) > 0) Then
         sFile = strDir + sName
         If ((fdata.dwFileAttributes And vbDirectory) <> 0) Then
            Set child = New CRecursiveFind
            sFile = child.FindFirst(sFile, strMask)
            If (Len(sFile) = 0) Then Call ResetChild
         ElseIf (Not sName Like strMask) Then
            sFile = ""
         End If
      End If

   ...
   
End Function

[dglienna]

I had this laying around.

Option Explicit
' posted by someone at VBForums in the past

Private Sub cmdSearch_Click()
  Dim colFiles    As Collection
  Dim objFile     As File
  Dim lngIndex    As Long
  Screen.MousePointer = vbHourglass
  DoEvents
  Set colFiles = New Collection
  SearchFolders "D:\temp\", "*.jpg", True, colFiles
  For lngIndex = 1 To colFiles.Count
      Set objFile = colFiles.Item(lngIndex)
      lstfiles.AddItem objFile.ParentFolder & "\" & objFile.Name
  Next lngIndex
  Screen.MousePointer = vbDefault
End Sub

Public Sub SearchFolders(ByVal pstrFolder As String, ByVal pstrFileSearch As String, ByVal pblnSearchSubFolders As Boolean, ByRef pcolFiles As Collection)
  Dim objFolder           As Folder
  Dim objSubFolder        As Folder
  Dim objSubFolders       As Folders
  Dim objFile             As File
  Dim objFiles            As Files
  Dim objFSO              As FileSystemObject
  Set objFSO = New FileSystemObject
  If objFSO.FolderExists(pstrFolder) Then
    Set objFolder = objFSO.GetFolder(pstrFolder)
    Set objFiles = objFolder.Files
    For Each objFile In objFiles
        If objFile.Name Like pstrFileSearch Then
            pcolFiles.Add objFile
        End If
    Next objFile
    Set objFiles = Nothing
    If pblnSearchSubFolders Then
      Set objSubFolders = objFolder.SubFolders
      For Each objSubFolder In objSubFolders
          SearchFolders objSubFolder.ParentFolder & "\" & objSubFolder.Name, pstrFileSearch, pblnSearchSubFolders, pcolFiles
      Next objSubFolder
      Set objSubFolders = Nothing
    End If
    Set objFolder = Nothing
  End If
  Set objFSO = Nothing
End Sub