使用 Excel VBA 进行字符串匹配时，迭代子文件夹并在资源管理器中打开文件夹

Question

我正在尝试打开一个带有 explorer.exe 的文件夹，当单击的单元格中有一个值时，单击一个单元格即可触发该文件夹。

我的单击操作和打开文件夹操作工作正常，因为我在其他子项目中使用过它们。

我失败的地方是无法仅根据单击的单元格中的值找到正确的子文件夹。

此代码将通过单击启动子程序：

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

以下代码将打印所有文件夹路径到立即窗口：

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

我想要对结果执行的操作是在文件夹路径中查找特定字符串，然后打开该文件夹。我的代码是：

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

但它不起作用。从未找到该文件夹。我认为这是因为当前

subFolder

是一个对象而

wO

是一个字符串，类型不匹配。我正在考虑将

subFolder

的当前迭代转换为字符串，但我找不到这样做的简单解释。

虽然

Debug.Print

可以将

subFolder

值强制放入立即窗口，但我不认为

inStr

或

Shell

命令可以在其当前类型中使用

subFolder

。

任何有关如何解决此问题的想法将不胜感激。

Answer 1

尝试一下 - 文件夹枚举中的一些更改：

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
        Shell "explorer.exe """ & foundFolder.Path & """" 'space, and quotes around path
    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