Finding Folders with VBScript

 I once worked somewhere that didn't have any discernable software solution for navigating between work folders so I ended up putting together some VBScript and assigning a shortcut so that I could search for a folder named with a given job number from a given parent folder. Actually what I needed was something that would look within subfolders a level down from the parent folder and at that level only, in writing this it seems that it might be nice to be able to look at each folder's subfolders recursively as well so here's the code for both!.

Finding folders at a certain level

Finding folders at a certain level is quite simple, all you need to do is amend the amount of loops you set in the main sub below. it's currently set so that it will look at folders two levels down from the given so with a structure of Path>Projects>Work you would be looking at all folder names at the Work level, here's the code:

Option Explicit
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
Const START_DIR = "C:\Users\Joi\Desktop\cache"
dim Search
Search = InputBox("Please enter the Search Value:", _
"Find Local Files")

doFolder START_DIR, search


' pass in parent folder and search value
sub doFolder(path, searchVal)
    Dim found
    found = 0
    Dim folder, files, file, prjsubfolders,prjsubfolder, prjWorkSubFolders, prjWorkSubFolder

    set folder = FSO.getFolder(path)
    set files = folder.Files
    ' we're now looking at project folders (in1)
    set prjsubfolders = folder.subFolders
    For Each prjsubfolder in prjsubfolders
        set prjWorkSubFolders = prjsubfolder.subFolders
        ' looking at Project Folders and just grabbing their subfolders
        For Each prjWorkSubFolder in prjWorkSubFolders
            'looking at Work folders and testing on their name
            If InStr(1, prjWorkSubFolder.Name, SearchVal, vbTextCompare) > 0 Then
                openFolder(prjWorkSubFolder.Path)
                found = 1
                ' Found it!!
            Else
                ' if you want to do something
            End If 
        Next 
    Next
    if found = 0 then
        msgbox "sorry, I couldn't find that one"
    end if
end sub 


sub openFolder(path)
    Dim shell
    Set shell = wscript.CreateObject("Shell.Application")
    shell.Open path
End Sub

Finding any subfolder recursively

I need to finish this...