Driving me crazy- FileSearch Object hunging the application during search execution !!

[Jaafar Tribak]

Greetings all,

The following code simply performs a file search on the C root using the FileSearch object. I set up the search criteria so that the file search takes a while in order to illustrate this problem.

Sub test()
 
    Dim oFileSearch As FileSearch
 
    Set oFileSearch = Application.FileSearch
 
        With oFileSearch
            .NewSearch
            .LookIn = "C:"
            .SearchSubFolders = True
            .Filename = "ab"  [COLOR=seagreen]' just random chars for the sake of this exmpl.[/COLOR]
            .MatchTextExactly = False
            .FileType = msoFileTypeAllFiles
            .Execute
            For i = 1 To .FoundFiles.Count
                strFiles = strFiles & vbCrLf & .FoundFiles(i)
            Next i
        End With
 
        MsgBox strFiles
 
    Set oFileSearch = Nothing
 
End Sub

The problem with this search , as you know, is that it causes the application to hung until the search is finished making any user interaction with the application impossible.

Depending on the search criteria, the search can take a very long time. I am wondering if there is a way around this problem.

I don't want to run this code on another background process/App and I know that i could stick a DoEvents within a Dir file search but that's not what i am asking. I really need to use the FileSearch object.

Any thoughts on this will be much appreciated.

Regards.

 

[hatman]

I'm not clear on what you are asking, Jafaar. Are you looking for a way to multi-thread, or a way to speed up the search, so it doesn't take so long?

 

[Jaafar Tribak]

I'm not clear on what you are asking, Jafaar. Are you looking for a way to multi-thread, or a way to speed up the search, so it doesn't take so long?

Thanks hatman,

yes multi-treading to enable the user to interact with application while the search is running.


Sorry, i reread the post and was confusing.

Regards.

 

[Jaafar Tribak]

Bump ^

I posted a close question relating to this FileSearch object asking if the file search could be aborted if the search took too long. Alas, no answer was provided and i've googled this subject with no luck.

There's got to be a way to prevent this FileSearch object from blocking the application or at least to be able to abort the search once it has started.

I am just curious more than anything else to find a solution.

Any thoughts ?

Regards.

 

[hatman]

I don't think you're gonna get there without multithreading, which isn't supported in Excel VBA

Just for kix, I referenced the VBA Extensibility library, and Trusted VBA Access to projects, and put the following code together:

Sub stuff()
        
    Dim xl As Excel.Application
    Dim wb As Workbook
    Dim VBAEditor As VBIDE.VBE
    Dim VBComp As VBIDE.VBComponent
    Dim CodeMod As VBIDE.CodeModule
    
    Set xl = New Excel.Application
    
    Set wb = xl.Workbooks.Add
    
    Set VBAEditor = xl.VBE
    
    Set VBComp = wb.VBProject.VBComponents.Add(vbext_ct_StdModule)
    
    Set CodeMod = VBComp.CodeModule
    
    With CodeMod
            
        .InsertLines .CountOfLines + 1, "Sub Test()"
        
        .InsertLines .CountOfLines + 1, "Dim oFileSearch As FileSearch"
        
        .InsertLines .CountOfLines + 1, "Set oFileSearch = application.FileSearch"
        
        .InsertLines .CountOfLines + 1, "With oFileSearch"
        
        .InsertLines .CountOfLines + 1, ".NewSearch"
        
        .InsertLines .CountOfLines + 1, ".LookIn = " & Chr(34) & "D:\Documents and Settings\sasurpa" & Chr(34)
        
        .InsertLines .CountOfLines + 1, ".SearchSubFolders = True"
        
        .InsertLines .CountOfLines + 1, ".Filename = " & Chr(34) & "ab" & Chr(34)
        
        .InsertLines .CountOfLines + 1, ".MatchTextExactly = False"
        
        .InsertLines .CountOfLines + 1, ".FileType = msoFileTypeAllFiles"
        
        .InsertLines .CountOfLines + 1, ".Execute"
        
        .InsertLines .CountOfLines + 1, "For i = 1 To .FoundFiles.Count"
        
        .InsertLines .CountOfLines + 1, "strFiles = strFiles & vbCrLf & .FoundFiles(i)"
        
        .InsertLines .CountOfLines + 1, "Next i"
        
        .InsertLines .CountOfLines + 1, "End With"
        
        .InsertLines .CountOfLines + 1, "MsgBox strFiles"
        
        .InsertLines .CountOfLines + 1, "Set oFileSearch = Nothing"
        
        .InsertLines .CountOfLines + 1, "End Sub"
        
    End With
    
    Set VBComp = wb.VBProject.VBComponents("ThisWorkbook")
    Set CodeMod = VBComp.CodeModule
    
    With CodeMod
         linenum = .CreateEventProc("SheetActivate", "Workbook")
        
        .InsertLines linenum + 1, "Call Test"
    End With
    
    xl.Worksheets(2).Select
    Set xl = Nothing
    
    MsgBox "RUNNING"
 
End Sub

And BOTH applications locked up. I found that wierd, since you can usually run two separate Excel applications, without having to "share" resources. I'm a little bit stymied by this, since I often run a macro in the background in one Excel application, to download MP3's (which may take hours) while developing debugging and running VBA code in another Excel instance. I wonder if my method abov is simply flawed, and I've somehow created a parent/child relationship between the two instances that does't normally exist.

Anyway, this is the best brute force method i can come up with...

 

[Jaafar Tribak]

Thanks very much hatman for the follow up.

I did some excel interprocess coding before and worked quite well even without the need to use the VBA Extens .

However, as I mentioned earlier I wish i could come up with an in-process solution for this if only for the sake of learning.

I am currently working on something that looks promising- will post later what i've come up with.

Again thanks for the ineterest.

Regards.

 

[hatman]

As usual, Jaafar, you are about 10 steps ahead of me already The code I posted was a crude experiment, so I'm not suprised it didn't work well... though I expected some interprocess solution to work best. I'd be interested see something that works in-process, though I can't imagine how that would operate...

 

[Jaafar Tribak]

Well, here is something promising. I've managed to run the Application.FileSearch Method in-process while still allowing the user to interact with the application during the search plus provide the ability to abort the search at any time.

workbook demo.


code in a standard module ( run the StartSearch routine)

Option Explicit
 
Private Declare Function CreateThread Lib "kernel32" _
(lpThreadAttributes As Any, _
ByVal dwStackSize As Long, _
ByVal lpStartAddress As Long, _
lpParameter As Any, _
ByVal dwCreationFlags As Long, _
lpThreadID As Long) As Long
 
Private Declare Function TerminateThread Lib "kernel32" _
(ByVal hThread As Long, _
ByVal dwExitCode As Long) As Long
 
Private Declare Function WaitForSingleObject Lib "kernel32" _
(ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long
 
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
 
 
Private ThreadHandle    As Long
Private bSearchAborted As Boolean
Private strFiles As String
 
 
Sub StartSearch()
 
    Const lTimeOut As Long = 10  'millisecds
    Dim lWaitNum As Long
 
    On Error Resume Next
 
    bSearchAborted = False
 
    If ThreadHandle <> 0 Then
        MsgBox " The file search is still running.", vbInformation
        Exit Sub
    End If
 
    ThreadHandle = CreateThread _
    (ByVal 0&, ByVal 0&, AddressOf FileSearch, 0, 0, 0)
 
    Do
        lWaitNum = WaitForSingleObject(ThreadHandle, lTimeOut)
        DoEvents
    Loop Until (lWaitNum = 0) Or bSearchAborted
 
    If ThreadHandle <> 0 Then
        Call TerminateThread(ThreadHandle, ByVal 0&)
        ThreadHandle = 0
        CloseHandle ThreadHandle
    End If
 
    If Len(strFiles) = 0 Then
        MsgBox "Search Aborted."
    Else
        MsgBox "Files found : " & vbCrLf & strFiles
    End If
End Sub
 
Sub AbortSearch()
 
    bSearchAborted = True
 
End Sub
 
Private Sub FileSearch()
 
    Dim oFileSearch As FileSearch
    Dim i As Long
    On Error Resume Next
 
    strFiles = ""
 
    Set oFileSearch = Application.FileSearch
 
    With oFileSearch
        .NewSearch
        .LookIn = "C:"
        .SearchSubFolders = True
        .FileName = "*"
        .MatchTextExactly = False
        .FileType = msoFileTypeAllFiles
        .Execute
        For i = 1 To .FoundFiles.Count
            strFiles = strFiles & vbCrLf & .FoundFiles(i)
        Next i
    End With
 
    Set oFileSearch = Nothing
 
End Sub

I've tested this on Win XP excel 2003 and Win 2000 and despite using multithreading , the code actually seems quite stable !

One caveat though, if the user aborts the file search, they cannot start a new search unless they close and restart the application.something to do with the inner workings of the FileSearch object that gets corrupted if the search is ubruptly aborted.

I suspect the remedy for this is to run the filesearch via the createProcess API. Will look into this further and post back.

I would like to hear if this works on other platforms as well.
Regards.