Searching/Listing files with same filename VB6 problem

[ftl25]

Hi,

I am writing a program in VB6 where I'm adding an "Import/Export" option to the file menu. Starting with export, I basically need to find all files matching a particular filename and zip and export them to a folder. Currently I am simply finding all the files (with different extensions) and showing them in a list box. It works fine the first time I run it, but second time the list box is empty. Can anyone help? Code is posted below.

Public Sub FILE_Export()
'Entry point
    Dim foundFile As String
    Do
        foundFile = FileFindFirst(ExamplesDIR, EditExecuteFileName & ".*")
        If Len(foundFile) Then
            foundFile = GetFileName(foundFile)
            frmExport.lstFiles.AddItem (foundFile)
        Else
            Exit Do
        End If
    Loop
frmExport.Show vbModal
End Sub

'Purpose     :  Performs a recursive search starting from the specified directory
'               to find the next matching file (uses the file scripting object)
'Inputs      :  sInitialDirectory                   The directory to begin the seach from
'               sFilePattern                        The file pattern to seach for eg. "*.xls"
'Outputs     :  Returns the full path and name of the next matching file
'Notes       :  Can be called recursively to find all instances of the specified file pattern

Function FileFindFirst(ByVal sInitialDirectory As String, ByVal sFilePattern As String) As String
    Static fso As Scripting.FileSystemObject, oDirectory As Scripting.Folder, oThisDir As Scripting.Folder
    Static ssLastPattern As String, ssLastFiles As String
    Dim sThisPath As String, sResString As String, sTestFile As String
    If (fso Is Nothing) = True Then
        Set fso = New Scripting.FileSystemObject
    End If

    If Right$(sInitialDirectory, 1) <> "\" Then
        sInitialDirectory = sInitialDirectory & "\"
    End If
    
    'Seach current directory
    sThisPath = sInitialDirectory
    sTestFile = dir$(sThisPath & sFilePattern)
    Do
        If FileExists(sThisPath & sTestFile) Then
            If InStr(1, ssLastFiles, "|" & sThisPath & sTestFile) = 0 Then
                'Found next matching file
                sResString = sThisPath & sTestFile
                Exit Do
            End If
        Else
            'No more matching files in this directory
            Exit Do
        End If
        'Get next matching file
        sTestFile = dir$
    Loop
    
    If Len(sResString) = 0 Then
        'File not found in sInitialDirectory, search sub directories...
        Set oDirectory = fso.GetFolder(sInitialDirectory)
        For Each oThisDir In oDirectory.SubFolders
            sThisPath = oThisDir.path
            If Right$(sThisPath, 1) <> "\" Then
                sThisPath = sThisPath & "\"
            End If
            
            sTestFile = dir$(sThisPath & sFilePattern)
            Do
                If FileExists(sTestFile) Then
                    If InStr(1, ssLastFiles, "|" & sThisPath & sTestFile) = 0 Then
                        'Found next matching file
                        sResString = sInitialDirectory & sTestFile
                    End If
                Else
                    'No more matching files in this directory, check its subfolders
                    sTestFile = FileFindFirst(sThisPath, sFilePattern)
                    If FileExists(sTestFile) Then
                        If InStr(1, ssLastFiles, "|" & sThisPath & sTestFile) = 0 Then
                            'Found next matching file
                            sResString = sTestFile
                            Exit Do
                        End If
                    Else
                        'File not found in sub folder
                        Exit Do
                    End If
                End If
                sTestFile = dir$
            Loop
            If Len(sResString) Then
                'Found next matching file
                Exit For
            End If
        Next
    End If
    
    If Len(sResString) Then
        'Store search parameters
        If sFilePattern = ssLastPattern Then
            'Routine has been called with same parameters, store all previously matching files
            ssLastFiles = ssLastFiles & "|" & sResString
        Else
            'Store matching file
            ssLastFiles = "|" & sResString
        End If
        ssLastPattern = sFilePattern
        'Return result
        FileFindFirst = sResString
    End If
End Function

[AndreRet]

The coding looks perfect. When you do however call frmExport the second time, clear the listbox first and then reload your query. This should solve your problem.

[ftl25]

I've tried that, but to no effect:

Public Sub FILE_Export()
'Demonstration Routine
    Dim foundFile As String
    [B]frmExport.lstFiles.Clear[/B]
    Do
        foundFile = FileFindFirst(ExamplesDIR, EditExecuteFileName & ".*")
        If Len(foundFile) Then
            foundFile = GetFileName(foundFile)
            frmExport.lstFiles.AddItem (foundFile)
        Else
            Exit Do
        End If
    Loop
frmExport.Show vbModal
End Sub

I'm very new to VB, I found the main algorithm online and built around it.

[ftl25]

I think I've found the issue - the two static objects are not being cleared -

Static ssLastPattern As String, ssLastFiles As String

However, if I set them to "", VB crashes. How can these be cleared?

[AndreRet]

Change all your static statements to Dim -

Dim ssLastPattern As String, ssLastFiles As String 'Before any string is added to ssLastPattern, clear it
ssLastPattern = vbNullString
ssLastFiles = vbNullString

Public Sub FILE_Export()
'Demonstration Routine
    Dim foundFile As String
    frmExport.lstFiles.Clear
    Do
        foundFile = FileFindFirst(ExamplesDIR, EditExecuteFileName & ".*")
        If Len(foundFile) Then
            foundFile = GetFileName(foundFile)
            frmExport.lstFiles.AddItem (foundFile)
        Else
            Exit Do
        End If
    Loop
frmExport.Show vbModal
End Sub

If this does not help, I will copy your code and go into it with more vengeance.

[ftl25]

Do you mean to declare these variables as global? Or where should I declare them? The calls are in the following structure:
Click button "Export". Then:

Private Sub mnuExport_Click()
FILE_Export
End Sub

FileExport:
Public Sub FILE_Export()
'Demonstration Routine
Dim ssLastPattern As String, ssLastFiles As String 'Before any string is added to ssLastPattern, clear it
ssLastPattern = vbNullString
ssLastFiles = vbNullString
    Dim foundFile As String
    Do
        foundFile = FileFindFirst(ExamplesDIR, EditExecuteFileName & ".*", ssLastPattern, ssLastFiles)
        If Len(foundFile) Then
            foundFile = GetFileName(foundFile)
            frmExport.lstFiles.AddItem (foundFile)
        Else
            Exit Do
        End If
    Loop
frmExport.Show vbModal
End Sub

Then, within FileFindFirst ssLastPattern and ssLastFiles are being populated. I can't clear them within FileFindFirst as an endless loop is entered, but declaring them outside doesn't seem to work either.

[AndreRet]

Let me test your code and post the solution in say an hour or so.

[ftl25]

Ok, thank you, here are the other two methods (GetFileName and FileExists):

Public Function GetFileName(flname As String) As String
    
    'Get the filename without the path.
    'Input Values:
    '   flname - path and filename of file.
    'Return Value:
    '   GetFileName - name of file without the path.
    
    Dim posn As Integer, I As Integer
    Dim fname As String
    
    posn = 0
    'find the position of the last "\" character in filename
    For I = 1 To Len(flname)
        If (Mid(flname, I, 1) = "\") Then posn = I
    Next I

    'get filename without path
    fname = Right(flname, Len(flname) - posn)
    GetFileName = fname
End Function

'Purpose     :  Checks if a file exists
'Inputs      :  sFilePathName                   The path and file name e.g. "C:\Autoexec.bat"
'Outputs     :  Returns True if the file exists


Function FileExists(sFilePathName As String) As Boolean
    On Error GoTo ExitFunction
    If Len(sFilePathName) Then
        If (GetAttr(sFilePathName) And vbDirectory) < 1 Then
            'File Exists
            FileExists = True
        End If
    End If
ExitFunction:
End Function

[ftl25]

I think I've resolved, merging both methods I was able to clear sResString and foundFile, and also the static objects changed to Dims as you suggested before:

Public Sub FILE_Export()
'Demonstration Routine
    Dim sThisPath As String, sResString As String, sTestFile As String
    Static fso As Scripting.FileSystemObject, oDirectory As Scripting.Folder, oThisDir As Scripting.Folder
    Dim ssLastPattern As String, ssLastFiles As String
    ssLastPattern = vbNullString
    ssLastFiles = vbNullString
    
    Dim foundFile As String, sInitialDirectory As String, sFilePattern As String
    sInitialDirectory = ExamplesDIR
    sFilePattern = EditExecuteFileName & ".*"
    Do
        If (fso Is Nothing) = True Then
            Set fso = New Scripting.FileSystemObject
        End If

        If Right$(sInitialDirectory, 1) <> "\" Then
            sInitialDirectory = sInitialDirectory & "\"
        End If
    
        'Seach current directory
        sThisPath = sInitialDirectory
        sTestFile = dir$(sThisPath & sFilePattern)
        Do
            sResString = ""
            foundFile = ""
            If FileExists(sThisPath & sTestFile) Then
                If InStr(1, ssLastFiles, "|" & sThisPath & sTestFile) = 0 Then
                    'Found next matching file
                    sResString = sThisPath & sTestFile
                    Exit Do
                End If
            Else
                'No more matching files in this directory
                Exit Do
            End If
            'Get next matching file
            sTestFile = dir$
        Loop
    
        If Len(sResString) Then
            'Store search parameters
            If sFilePattern = ssLastPattern Then
                'Routine has been called with same parameters, store all previously matching files
                ssLastFiles = ssLastFiles & "|" & sResString
            Else
                'Store matching file
                ssLastFiles = "|" & sResString
            End If
            ssLastPattern = sFilePattern
            'Return result
            foundFile = sResString
        End If
        
            If Len(foundFile) Then
                foundFile = GetFileName(foundFile)
                frmExport.lstFiles.AddItem (foundFile)
            Else
                Exit Do
            End If
    Loop
frmExport.Show vbModal
End Sub

[AndreRet]

I have changed the Static in

Static fso As Scripting.FileSystemObject, oDirectory As Scripting.Folder, oThisDir As Scripting.Folder

to Dim as well, tested and the list box gets populated every time that i click on the cmd button, soo, all looks fine to me at this moment. Your side?

[ftl25]

Perfect - works a treat :) Thank you, this is my first time posting on the VB forums, and you've been most helpful and prompt. No doubt it won't be my last time posting here!

[AndreRet]

It was only a pleasure. Will see you around the forum. Happy coding.