Iterate through subfolders and open a folder in Explorer when a string match is made using Excel VBA

Question

I am attempting to open a folder with explorer.exe triggered by a single click on a cell when there is a value in the clicked cell.

I have the click action and the open folder action working fine as I have used them in other subs.

Where I am failing is in being able to find the correct subfolder based only on the value in the cell being clicked.

This code will start the sub with the single click:

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'single click version

    Dim FileSystem As Object
    Dim HostFolder As String
    
    If Len(ActiveCell) > 3 Then
    
        If Intersect(Target, Range("ay5:ay15")) Is Nothing Then
            Exit Sub
        Else
        
            wO = ActiveCell
            
            DropboxLocation 'gets users Dropbox folder path and sets it to variable userDBfolder
        
            HostFolder = userDBfolder & "\~ Completed Jobs\Jobsite Pictures\"
        
            Set FileSystem = CreateObject("Scripting.FileSystemObject")
            DoFolder FileSystem.getFolder(HostFolder)
            
        End If
    Else
    End If
        
End Sub

The following code will print all the folder paths to the Immediate Window:

Sub DoFolder(Folder)
    
    Dim subFolder
    Dim pathMatch

    For Each subFolder In Folder.SubFolders
        DoFolder subFolder
        Debug.Print (subFolder) 'This is where I also put the search code found below
    Next
    
End Sub

What I am trying to do with the result is to find a specific string in the folder path and then open the folder. My code for this is:

        pathMatch = InStr(subFolder, wO)
        If pathMatch > 0 Then
            Shell "explorer.exe" & subFolder
            Exit Sub
        Else
        End If

and it doesn't work. The folder is never found. I am thinking this is because of a type mismatch with the current subFolder being an object and wO being a string. I was thinking to convert the current iteration of subFolder to a string but I couldn't find a simple explanation for doing that.

While Debug.Print can coerce the subFolder value into the Immediate Window, I don't think inStr or the Shell command can use the subFolder in it's current type.

Any thoughts on how to solve this would be appreciated.

Answer 1

Try this out - some changes in the folder enumeration:

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'single click version

    Dim FileSystem As Object
    Dim HostFolder As String, v, foundFolder As Object
    
    If Intersect(Target, Me.Range("ay5:ay15")) Is Nothing Then Exit Sub
    v = Trim(Target.Value)
    If Len(v) <= 3 Then Exit Sub 'value too short
        
    DropboxLocation 'ideally this would be a Function...
    HostFolder = userDBfolder & "\~ Completed Jobs\Jobsite Pictures\"

    Set FileSystem = CreateObject("Scripting.FileSystemObject")
    Set foundFolder = FindFolder(FileSystem.GetFolder(HostFolder), CStr(v))
    If Not foundFolder Is Nothing Then
        'space, and quotes around path
        Shell "explorer.exe """ & foundFolder.Path & """", vbNormalFocus 
    Else
        MsgBox "No folder found for '" & v & "'"
    End If
    
        
End Sub

'Find a folder whose name contains `strMatch`, starting with `fldrStart`
'  Returns Nothing if no match
Function FindFolder(fldrStart As Object, strMatch As String)
    Dim queue As New Collection
    Dim subFolder As Object, fldr As Object
    
    queue.Add fldrStart
    Do While queue.Count > 0
        Set fldr = queue(1)   'grab item from queue
        queue.Remove 1        '...and remove it
        If InStr(1, fldr.Name, strMatch, vbTextCompare) > 0 Then
            Set FindFolder = fldr
            Exit Function
        End If
        'add subfolders to queue
        For Each subFolder In fldr.subFolders
            queue.Add subFolder
        Next subFolder
    Loop
End Function