Loop through folders with shell object.

Hello,

I have this code that loops through networks folder/subfolders and search all files with plan in its name.

But it is take a long time to find all files, because of network folder, many subfolders and many files.

I have heard that it is possible to speed code up with shell object. Can anybody help me to get it to work with shell object?


Dim fso As FileSystemObject

Private Sub Command1_Click()

Dim fld As Folder

Dim ParentFolder As String

ParentFolder = "R: \Documents\Plans\"

' Set fso = New FileSystemObject

' Set fld = fso.GetFolder(""R: \Documents\Plans\")


Set objShell = CreateObject("Shell.Application")

Set fld = objShell.Namespace(ParentFolder)


RecursiveSearch fld, "plan.doc"


Set fld = Nothing

Set fso = Nothing

End Sub

This uses RECURSION, and is FAST. The network permission problems might be slowing your down. Try MAPPING the drive first.

This will load all .JPG file names (in the \TEMP folder) into a listbox.

Code:

---

Option Explicit
' posted by Wokawidget

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

---

Like it a little bit shorter?

Code:

---

Private Sub Command1_Click()

  Dim ParentFolder As String, fld As Folder, fso As FileSystemObject
  ParentFolder = "c:\Test"
  Set fso = New FileSystemObject
  Set fld = fso.GetFolder("c:\test")
  RecursiveSearch fld, "*.*"
End Sub

Private Sub RecursiveSearch(Fold As Folder, FileName As String)
'will add all occurrences of FileName to a listbox List1
  Dim fil As File, fld As Folder
  For Each fil In Fold.Files
    If fil.Name Like FileName Then List1.AddItem fil.Path
  Next
  For Each fld In Fold.SubFolders
    RecursiveSearch fld, FileName
  Next
End Sub

---

Why I get a error "object required" at the line List1.AddItem fil.Path

Maybe because I tested mine?

Code:

---

lstfiles.AddItem objFile.ParentFolder & "\" & objFile.Name

---

Your form needs a Listbox control called lstfiles for mine

Yes. Mine would require a ListBox named List1
But you can change the line nto: If fil.Name Like FileName Then Debug.Print fil.Path
It depends onwhat you want to do with the found filename.

It is working but it is very slowly... Because of many subfolders and many files.
Is there any way to speed up this code?

Maybe you will find something useful on this page
http://vbnet.mvps.org/index.html?cod...api/index.html

Yeah, datamiser has it... BTW: Wof, D, the fso is the slowest possible way to do a search, even the drive, dir, and file list boxes are faster (when they are not visible and just barely slower when they are only part of the time...)...

I kind of suspected that it may be a bit slow. I have never used it in any real VB code so could not be sure. I have used it in scripting and in embedded VB only then because the file methods I would normally use are not available.

Well, everything runs fast on this machine. Probably no difference for 500gb

I find out that if I want to have extremely fast routine then I must to have FindFirstFile and FindNextFile API solution or solution with Dir.
With the first one I can get 7400 files for 1.22 seconds. It is really fast!

Has anybody some suggestion about this to solution?

Quote:

---

Originally Posted by Derend

I find out that if I want to have extremely fast routine then I must to have FindFirstFile and FindNextFile API solution or solution with Dir.
With the first one I can get 7400 files for 1.22 seconds. It is really fast!

Has anybody some suggestion about this to solution?

---

Did you see the link I posted? It has lots of file API stuff

I'm aware that FSO is the slowest of available methods for that, but it allows for short and comprehensive code.

I once made this little program to compare API, VB Dir$ and FSO. It contains all three methods, where I took the FindFilesAPI() from allapi.net

You have to enter your own path in the txtPath textbox. It is hardcoded. It is only to compare speeds.
After clicking one of the buttons it takes a while to fill the listbox.
When done the bottom left textfield shows the elapsed time in milliseconds.
To measure the runtime I make use of a little dll (GetTime.dll) a friend of mine wrote for me in C++. It is not for distribution, please.

The program shows how API recursive walk through folders is done and should help understand and rewrite for own purposes.

Thanks guys for comments!

I found many usefull examples on that page http://vbnet.mvps.org/index.html?cod...api/index.html

But I could not find the right exampel that search files through folder and subfolders.

The most example search a specified folder.

dir *.txt /s

Look for recursive or recursion at that link... as there are several different examples on how to search an entire drive or a subset of folders and sub folders for files...

(Yeah D, I've used that one before but I do something like dir C:\a *.txt /b /s >c:\output.txt)



Good Luck

Hello again,

I have spent a little time to check some examples on that link http://vbnet.mvps.org/index.html?cod...api/index.html
I have tested this examples, but it seems like none of them search subfolders.

FindFirstFile: Recursive File Search for Single or Multiple File Types (minimal code)
FindFirstFile: Recursive File Search Including/Excluding Single or Multiple File Types (minimal code)
FindFirstFile: Recursive Search for Folders Using a Folder Mask (minimal code)
FindFirstFile: Recursive File Search (minimal code)
FindFirstFile: Recursive Search for Folders (minimal code)

Is it me that see it wrong or it really is like this?

Can anybody help with this?

Have you considered that you may need to combine 2 of these to get your results?

Keep in mind I have not looked through these but if as you say they search for files in a single folder then you may need to use one to search for sub directories and then another to search for files in each of those sub directories.

btw that little method shown by vb5prgrmr is fairly quick and not to difficult to use. It will generate a file that has all the results in it. You would just need to parse out that file when it completes.

I don't know what you actually want, Derend.
If you look at my sample project, it shows three methods to RECURSIVELY list all contents of a folder and its subfolders.
For easy comprehension I have snapped together the API code to a short and rather fast procedure. It assumes a ListBox named lstFiles to accept and display the entries.

Code:

---

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 GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Const FILE_ATTRIBUTE_DIRECTORY = &H10

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 Sub ListFilesAPI(ByVal StartingPath As String, ByVal Pattern As String)
  Dim CurName As String, CurFull As String
  Dim Dirs As New Collection
  Dim hSearch As Long
  Dim WFD As WIN32_FIND_DATA
  Dim i%, cont%
 
  If Right$(StartingPath, 1) <> "\" Then StartingPath = StartingPath + "\"
 
  'walk through all entries to find the folders
  cont = 1
  hSearch = FindFirstFile(StartingPath + "*", WFD)
  If hSearch <> INVALID_HANDLE_VALUE Then
    Do While cont
        CurName = StripNulls(WFD.cFileName)
        If CurName <> "." And CurName <> ".." Then
          CurFull = StartingPath + CurName
          If GetFileAttributes(CurFull) And FILE_ATTRIBUTE_DIRECTORY Then Dirs.Add CurName
        End If
        cont = FindNextFile(hSearch, WFD)
    Loop
    cont = FindClose(hSearch)
  End If
 
  'now walk again through all entries finding files that match the search pattern
  cont = 1
  hSearch = FindFirstFile(StartingPath + Pattern, WFD)
  If hSearch <> INVALID_HANDLE_VALUE Then
    Do While cont
        CurName = StripNulls(WFD.cFileName)
        If CurName <> "." And CurName <> ".." Then lstFiles.AddItem StartingPath + CurName
        cont = FindNextFile(hSearch, WFD)
    Loop
    cont = FindClose(hSearch)
  End If
 
  'now recursively call self for all subfolders
  For i = 1 To Dirs.Count
      ListFilesAPI StartingPath + Dirs(i), Pattern
  Next
End Sub

---

If you like variations on a theme, here is another little example I worked out.
It seems to be even faster than API code using Dir$(), although it does not feature pattern matching.
It simply lists all files in the folder and its subfolders.

Code:

---

Private Sub ListAllFilesDIR(ByVal StartingFolder As String)
  Dim CurDir As String
  Dim CurName As String
  Dim Dirs As New Collection
  Dim FullName As String
 
  If Right$(StartingFolder, 1) <> "\" Then StartingFolder = StartingFolder + "\"
 
  Dirs.Add StartingFolder
 
  While Dirs.Count
    CurDir = Dirs(1)
    Dirs.Remove 1
    CurName = Dir$(CurDir, vbDirectory)
    While CurName <> ""
      If CurName <> "." And CurName <> ".." Then
          FullName = CurDir + CurName
          If GetAttr(FullName) And vbDirectory Then Dirs.Add FullName + "\"
          lstFiles.AddItem FullName
      End If
      CurName = Dir$
    Wend
  Wend
End Sub

---

Again it will list files in a ListBox named lstFiles.
This is a rather short, comprehensive and elegant way which does not even do recursive calling, although it still walks through all subfolders.
For pattern matching we'd have to do it a little different.

Would be a bit faster if you set the lstfiles.visible=false at the top and true at the bottom

Powershell

Code:

---

# PowerShell script to find executable in the Windows folder
$Path = "C:\windows"
$wind =get-Childitem $Path -recurse | where{$_.Extension -match "exe"}
$wind

---

@DataMiser: that's true. It will be a leeettle faster then.

@David: Hem, hem... Ys thys VB6 code? You seem to be yn the wrong forum. ;)

BTW.: I'm a little amazed that the Dir$() version is almost as fast as the API calls. I say almost, since if I'd have to modify the routine for pattern matching we'd have to make double passes through the folders and thus being a little slower than API, I guess.

I don't think you would need additional passes just need to compare the text of the fullname to your search pattern before adding it to the list

Where should I give search path and search file type in your codes WOF?

Powershell 2.0 is the new DOS. All the new Microsoft programs understand it.
It also utilizes the Net framework, under the covers.

Why NOT use it?

How to access the Registry:

Quote:

---

c:\Powershell
PS C:\Users\David> cd hklm:
PS HKLM:\software> cd \software
PS HKLM:\software> dir


Hive: HKEY_LOCAL_MACHINE\software


SKC VC Name Property
--- -- ---- --------
1 0 Acronis {}
1 0 ASUS {}
1 0 ATI Technologies {}
1 0 Audible {}
1 0 Business Objects {}
447 0 Classes {}
7 0 Clients {}
3 0 Diskeeper Corporation {}
1 0 Dolby {}
1 0 Hauppauge {}
1 0 InstalledOptions {}
2 0 Intel {}
2 0 JavaSoft {}
1 0 Khronos {}
1 0 MainConceptMCE {}
4 0 MCCI {}
188 1 Microsoft
[removed]
PS HKLM:\software>

---

I think the intention was to do this in a vb6 project, I haven't used powershell for anything as of yet but I would be surprised if it intergrated with VB6. Also I find it hard to believe that it would be any faster or even as fast as doing it through VB code directly. There is a lot of overhead in the .net framework

Quote:

---

Originally Posted by Derend

Where should I give search path and search file type in your codes WOF?

---

In the first example it would be "StartingPath" and "Pattern"
The second example "StartingFolder" there is no code there for pattern but could be added with ease.

Quote:

---

Originally Posted by DataMiser

I haven't used powershell for anything as of yet but I would be surprised if it intergrated with VB6. Also I find it hard to believe that it would be any faster or even as fast as doing it through VB code directly. There is a lot of overhead in the .net framework

---

You can shell() any command, whether DOS or PS. If you don't think Net is faster than API, then you should test. I'd think .Net framework is a magnitude of order faster. Come up with some sort of test, and I'll run it.

I know you can shell but then there is the matter of getting the results, pretty much the same as if you used the dir /s method. Once it completes then you must parse out the file generated and search for the results there.

As for the speed I have not did a lot of comparisson but in general API commands are typically pretty quick where the .net routines seem to be rather sluggish especially on the first run when the framework may not already be loaded into memory of the system.

Think about the memory required? How many bytes do you think are used to load the .net framework and do a simple dir listing? How many would you think is needed for Dos Dir or VB Dir. my guess would be that .net is more than double the combination of the 2.

You can do all kinds of parsing, or formatting. You can send the results to a list, or a listbox. Doesn't matter.

Once you have W2K8 Server Core, there is NO GUI at all. Powershell is the only way to operate the server

This adds "Pattern" as 'search file type' to the procedure:

Code:

---

Private Sub ListAllFilesDIR(ByVal StartingFolder As String, Pattern As String)
  Dim CurDir As String
  Dim CurName As String
  Dim Dirs As New Collection
  Dim FullName As String
 
  If Right$(StartingFolder, 1) <> "\" Then StartingFolder = StartingFolder + "\"
 
  Dirs.Add StartingFolder
 
  While Dirs.Count
    CurDir = Dirs(1)
    Dirs.Remove 1
    CurName = Dir$(CurDir, vbDirectory)
    While CurName <> ""
      If CurName <> "." And CurName <> ".." Then
          FullName = CurDir + CurName
          If GetAttr(FullName) And vbDirectory Then Dirs.Add FullName + "\"
          If CurName Like Pattern Then lstFiles.AddItem FullName
      End If
      CurName = Dir$
    Wend
  Wend
End Sub

---

Why I was referring to making two passes is this:
If you do Dir$("*.*") file type matching takes place and also files with no extension are found.
Doing pattern matching with the 'Like' operator is a little different.
"*" will match ALL names
"*.*" will only match names with a dot in it, in fact which have an extension.
You have to know that to give a clear match pattern. In the above case you don't need an extra pass with Dir$(Pattern), but you'd have to know that *.* as a pattern would not, as would be expected from usual wildcarding, include files with no extension.

Concerning first run:
ALL variations, API, DIR or FSO are slower on the first run. I think this is because windows caches directory searches extensively. Second search of the same folders is much faster, no matter which technique is used.

With the dir function, you can use the pattern ("*.*") directly in the dir call, however only one pattern at a time...

Code:

---

ReturnString = Dir(InitialPath & SearchPattern, SearchAttributes)
'CurName = Dir$(CurDir & "*.*", vbDirectory)

---

will return files without a period extension e.g. thisfilenamewithnoextension
(which also means I need to modify some code I have...)

You have to look at the whole loop:

Code:

---

    CurName = Dir$(CurDir, vbDirectory)
    While CurName <> ""
      If CurName <> "." And CurName <> ".." Then
          FullName = CurDir + CurName
          If GetAttr(FullName) And vbDirectory Then Dirs.Add FullName + "\"
          If CurName Like Pattern Then lstFiles.AddItem FullName
      End If
      CurName = Dir$
    Wend

---

If you'd change the line of the first Dir call to
CurName = Dir$(CurDir & Pattern, vbDirectory)
you are fooled, except the pattern is "*.*", which it is by default if omitted.
But if you called for "*.jpg" for instance it will also only find folders which end in ".jpg"

It is working and it is searching subfolders.
But, still not enough quick, because of the numbers of searching subfolders (about 500) and searching files (about 250).
The number of subfolders and searching files will rise very quick in future.
Therefore I am looking for a quicker solution.
Thanks for many fine initiatives.

It always depends what to do with the filename strings.
Adding them to a listbox is time consuming the more files and the longer the pathes.
If you only search for distinct names you wouldn't find anything faster'n that. Not in VB6.

After some discussion with vb5prgrmr behind the curtains, and after some more fiddling I want to present you with the fastest scan loop I could produce. It uses API and needs the declarations of FindFirstFile(), FindNextFile() and WIN32_FIND_DATA as shown before.
The fastest way to test is to set lstFiles.Visible=False before calling this and then set visibility back on again.

Code:

---

Private Sub ListAllFilesAPI(ByVal StartingFolder As String)
' trying to do API search with only one pass
  Dim CurName As String, CurFull As String, CurDir As String
  Dim Dirs As New Collection
  Dim hSearch As Long
  Dim WFD As WIN32_FIND_DATA
  Dim i%, cont&
 
  If Right$(StartingFolder, 1) <> "\" Then StartingFolder = StartingFolder + "\"
  Dirs.Add StartingFolder
 
  While Dirs.Count
    CurDir = Dirs(1)
    Dirs.Remove 1
   
    cont = 1
    hSearch = FindFirstFile(CurDir + "*", WFD)
    If hSearch <> INVALID_HANDLE_VALUE Then
      Do While cont
          CurName = StripNulls(WFD.cFileName)
          If CurName <> "." And CurName <> ".." Then
            CurFull = StartingFolder + CurName
            If GetFileAttributes(CurFull) And FILE_ATTRIBUTE_DIRECTORY Then Dirs.Add CurName
            lstFiles.AddItem CurFull
          End If
          cont = FindNextFile(hSearch, WFD)
      Loop
    End If
  Wend
End Sub

---

It lists all files in the given folder and in all subfolders.
To work with pattern matching evenly fast you should add the Pattern parameter and use the Like operator in the line:
If CurName Like Pattern then lstFiles.AddItem CurFull

Where are the numbers??? Your fast dir vs your fast API?

Well, yes, just you wait. I still discovered a mistake in the above routine. Have to look for it.

Ok, for a final conclusion and figures now, here is this.

Code:

---

Public Sub ListAllFilesAPI(ByVal StartingFolder As String)
' trying to do API search with only one pass
  Dim CurName As String, CurFull As String, CurDir As String
  Dim Dirs As New Collection
  Dim hSearch As Long
  Dim WFD As WIN32_FIND_DATA
  Dim i%, cont&
 
  If Right$(StartingFolder, 1) <> "\" Then StartingFolder = StartingFolder + "\"
  Dirs.Add StartingFolder
 
  While Dirs.Count
    CurDir = Dirs(1)
    If Right$(CurDir, 1) <> "\" Then CurDir = CurDir + "\"
    Dirs.Remove 1
   
    cont = 1
    hSearch = FindFirstFile(CurDir + "*.*", WFD)
    If hSearch <> INVALID_HANDLE_VALUE Then
      Do While cont
          CurName = StripNulls(WFD.cFileName)
          If CurName <> "." And CurName <> ".." Then
            CurFull = CurDir + CurName
            If GetFileAttributes(CurFull) And FILE_ATTRIBUTE_DIRECTORY Then
                Dirs.Add CurFull
                MainForm.lstFiles.AddItem CurFull
            Else
                MainForm.lstFiles.AddItem CurName
            End If
          End If
          cont = FindNextFile(hSearch, WFD)
      Loop
    DoEvents
    End If
    cont = FindClose(hSearch)
  Wend
End Sub

---

This is the fastest I could work out.
I benched it with a folder that contains 44700 files in 6 subfolders.
Runtime for this was about 4.5 seconds.
The same procedure done with Dir instead of API was amazingly only 4.7 seconds, not very much slower than the API call.
Your procedure vb5prgrmr took 4.9 seconds, despite its heavy error checking a very good result.

Edit: after running both Dir and API calls several time I found execution time varies about 150ms, so as I can only say API and Dir givces nearly the same result.

Well, you should see what powershell does.

You are adding them to a lb, how about a file?

I've been using this for a LONG time to keep track of folder/file names:

If you write the other versions, I'll write a PS version. I can test, or you can test, as I have a current list of files (no timer yet)

Code:

---

Option Explicit
' (c) Siok Online 2006
' David Glienna
Dim fn$, rt%, j$
'
' Add a reference to Microsoft Scripting Control

Private Sub Form_Load()
  j = ""
  Open App.Path & "\list.txt" For Output As #1
    Print #1, "                Visual Basic Samples - " & Format(Date, "MMMM d, YYYY")
    Print #1, ""
    Print #1, "C:\Visual Basic Samples\"
    Print #1, ""
    RecurseFolderList "C:\Visual Basic Samples" ' You can use a folder or drive
    Print #1, ""
    Print #1, "Total Number of Programs : " & rt
    Print #1, ""
    Print #1, "                (c) SIOK Online 2008"
    Print #1, "                  C:\Visual Basic Samples\S\SearchforVBPfiles"
  Close #1
  MsgBox "Done."
  Unload Me
End Sub

Public Function RecurseFolderList(FolderName As String) As Boolean
  Dim f As Folder
  Dim fc As Folders
  Dim fj As Files
  Dim f1 As Folder
  Dim f2 As File
  Dim fso As New FileSystemObject
  If fso.FolderExists(FolderName) Then
      Set f = fso.GetFolder(FolderName)
      Set fc = f.SubFolders
      Set fj = f.Files
      'For each subfolder in the Folder
      For Each f1 In fc
      'Do something with the Folder Name
          'Then recurse this function with the sub-folder to get any'
          ' sub-folders
        RecurseFolderList (f1)
      Next
      'For each folder check for any files
        DoEvents
        For Each f2 In fj
              If LCase(Right(f2.Name, 3)) = "vbp" Then
                fn = f2.Name
                If j <> Mid(f2, 25, 1) Then
                  j = Mid(f2, 25, 1)
                  fn = "  " & Right(f2, Len(f2) - 24)
                Else
                  fn = "    - " & Right(f2, Len(f2) - 24)
                End If
                Print #1, fn
                rt = rt + 1
              End If
        Next
          Set f = Nothing
      Set fc = Nothing
      Set fj = Nothing
      Set f1 = Nothing
  Else
      RecurseFolderList = False
  End If
  Set fso = Nothing
End Function

---

I tried your ListAllFilesDir function on my system
took 11.6 seconds to scan 42,956 files in 4,519 folders

AMD X2 4400+ Windows XP MCE SP3

That was with a *.* filter
When I changed it to *.txt it took 1.7 seconds to scan the same folder and found 500 files in about 200 or so folders.

Post the code, and I'll time it, and build the specs

see post 34

There is no timer code, and it uses the listbox. PS can CREATE a listbox on the screen, but that's probably overkill at this point.

Load the names into a flat file like I did, add timer output, and we'll have something to run on each others system. Once there's 3 versions, I'll add the 4th.

I had an FSO version in my benchmark which wasn't any competition at all to the Dir and API versions.
Here I post the final program with multiple versions of the scan procedure, including the little timing dll (which is rather good), so as you can add procedures at your own gusto to compare them.
The structure is all the same: Add a button like there are already some, copy their code into the new button's click handler, change the call to your selfwritten procedure.

@vb5prgrmr: I had put your code into a module to include it, and - I'm sorry - stripped it from some comments to understand the structure. Sorry. I better understand if I see plain code.

Well, I wanted a version that produced a text file. That's why I posted the code that I had, that had no timing in it. I was going to do the Powershell version to write the same text file, and time it.

The listbox is a different animal with .Net. Slower the first time to deploy...