用于根据名称查找和打开文件夹的 VBA 代码

Question

基本上我想要做的是使用 vba 根据其名称查找并打开文件夹。我到处找，找不到解决办法。这就是

到目前为止，我没有任何反应。我想让用户点击一个 cmd 按钮，它会直接打开一个电影文件夹。

C:\Storage\Video\Video Folders\Genre\"文件夹"\"电影名称，年份"

Video Folders后面的文件夹路径可以根据“电影名称，年份”改变

Dim fso, Folder, subFlds, fld, s, showFolder as Object

Set fso = CreateObject("Scripting.FileSystemObject")
Set Folder = fso.GetFolder(Path)
Set subFlds = Folder.SubFolders

s = "C:\Storage\Video\Video Folders"
For Each fld In subFlds
    s = s & Me.FolderName
    s = s & "<br />"
Next
showFolder = s
Application.FollowHyperlink showFolder

Answer 1

您可以使用以下代码

• 在包含子文件夹的子文件夹的路径中按名称查找文件夹
• 然后在文件资源管理器中打开该路径。

我创建了一个单独的函数，以便能够递归调用它（查看子文件夹的子文件夹......）

用这个来调用主函数：

Sub openFolderIfFound()
    Dim path As String
    Dim folderName As String
    Dim folderPath As String

    path = "C:\Storage\Video\Video Folders"
    folderName = Me.FolderName
    ' Example: folderName = "Seven Samurai - 1954"
    ' Example using wildcards: folderName = "*Samurai*"
    folderPath = lookForFolderInPath(path, folderName)
    If folderPath <> "" Then Application.FollowHyperlink folderPath
    ' Note: in Excel use ThisWorkbook.FollowHyperlink folderPath
End Sub

查找文件夹的主要功能：

' Look for folder by name in path (including subfolders of subfolders)
' and return the path of the folder if it was found.
'
' Args:
'   path (String): Path to look in.
'   folderName (String): Name of folder to look for. Uses LIKE operator for comparison to enable the use of wildcards:
'     https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/like-operator
' Returns:
'   Path of folder if found else empty String ""
Function lookForFolderInPath(path As String, folderName As String, Optional ByRef fso As Object) As String
    Dim topFolder As Object
    Dim subfolders As Object
    Dim folder As Object
    Dim i As Long

    If fso Is Nothing Then Set fso = CreateObject("Scripting.FileSystemObject")
    Set topFolder = fso.GetFolder(path)
    Set subfolders = topFolder.subfolders

    ' Check if permission to access subfolders
    On Error Resume Next
    i = subfolders.Count
    On Error GoTo 0
    If i <> 0 Then
        ' Loop through subfolders of folder (path)
        For Each folder In subfolders
            If folder.Name Like folderName Then
                ' Return folder path if folder name matched subfolder name
                lookForFolderInPath = folder.path
                Exit For
            Else
                ' Recursively call function to check subfolders in subfolders
                lookForFolderInPath = lookForFolderInPath(folder.path, folderName, fso)
                ' Exit loop if folder was found
                If lookForFolderInPath <> "" Then Exit For
            End If
        Next
    End If

    Set fso = Nothing
    Set folder = Nothing
End Function

Answer 2

我不确定您要如何选择要打开的文件夹，但关键部分是这一行将解决您的问题。只需传递您要打开的文件夹的路径，它就会执行此操作并为用户激活窗口：

Sub OpenFolder(sPath)
    Call Shell("explorer.exe" & " " & sPath, vbNormalFocus)
End Sub

Answer 3

修改@Ibo 推荐的调用shell，这对我有用，或者说尽可能接近

子 cmd_folder_Click() 将文件夹作为字符串，s 作为字符串，loc 作为字符串

   s = "search-ms:query="
   loc = "&crumb=location:C:\Storage\Video\Video Folders\"
   Call Shell("explorer.exe " & Chr(34) & s & Me.Folder & loc & Chr(34), vbNormalFocus)

结束子