VBA - 如何在不知道全名的情況下打開文件夾

Question

我正在嘗試打開一個我不知道完整路徑的文件夾。

例如，父文件夾 dir 是“D:\Documents”，而我要打開的文件夾名為“22.111 - PROJECT_NAME”，我知道其中的代碼，但不知道名稱。 我試過用“*”，但沒有運氣。

Sub OpenFolder()

On Error GoTo Err_cmdExplore_Click

Dim Code As String

Code = Range("A1").Value
GoToFolder = "C:\Windows\explorer.exe D:\Documents\" & Code & "*"

Call Shell(GoToFolder, 1)

Exit_cmdExplore_Click:
Exit Sub

Err_cmdExplore_Click:
MsgBox ("Pasta não encontrada")
Resume Exit_cmdExplore_Click

End Sub

Answer 1

在另一個論壇 (mrexcel.com) 上找到了答案，將其留給面臨相同問題的任何人：

Public Sub Find_and_Open_Folder()

    Dim Code As String
    Dim targetFolder As String
    
    Code = Range("A1").Value
    
    targetFolder = Dir("D:\Documents\" & Code & "*", vbDirectory)
    If targetFolder <> vbNullString Then
        Shell "explorer.exe """ & "D:\Documents\" & targetFolder & """", vbNormalFocus
    Else
        MsgBox "Folder matching D:\Documents\" & Code & "* not found"
    End If
    
End Sub

Answer 2

有了可用的父文件夾並且知道子文件夾以22.111 ，您可以遍歷父文件夾中的所有子文件夾，並使用InStr列出所有可能的匹配項。 您如何執行此操作的示例：

Sub CodeSnippet()

Dim myFolderName As String

'GetFolders returns array
Dim folderNamesWithPattern As Variant

'searching for "22.111" at 1st pos in string of potential subfolder
folderNamesWithPattern = GetFolders("D:\Documents", "22.111", 1)

If UBound(folderNamesWithPattern) > 0 Then

    'more than one folder that meets your pattern:
        'decide what to do

Else

    'only one entry in array, this is your folder or if "" then ( no such folder | parent folder does not exist )
    myFolderName = folderNamesWithPattern(0)

End If

End Sub

Function GetFolders(strDirectory As String, pattern As String, position As Long) As Variant

    Dim objFSO As Object
    Dim objFolders As Object
    Dim objFolder As Object
    
    'create filesystem obj
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    'create folder obj and access subfolders property
    On Error GoTo errorHandler
    Set objFolders = objFSO.GetFolder(strDirectory).SubFolders
    
    'dim array for matches
    Dim arrFolderNames() As Variant
    
    arrFolderNames = Array()
    
    'loop through all folders
    For Each objFolder In objFolders
        
        'InStr() returns 0 if not found | index 1st char in string if found
        If InStr(objFolder.Name, pattern) = 1 Then
        
            'add match to array
            ReDim Preserve arrFolderNames(UBound(arrFolderNames) + 1)
            arrFolderNames(UBound(arrFolderNames)) = objFolder.Name

        End If
        
    Next objFolder

    'assign array for return
    GetFolders = arrFolderNames

errorHandler:

    If objFolders Is Nothing Then
    
        'parent folder does not exist
        GetFolders = Array("")

    ElseIf UBound(arrFolderNames) = -1 Then
    
        'we never found a subfolder that starts with pattern
        GetFolders = Array("")
    
    End If

End Function

如果您想使用 RegEx，您可能需要查看How do i use regex using instr in VBA 。

Answer 3

使用Workbook.FollowHyperlink瀏覽文件夾

• Workbook.FollowHyperlink method (MSDocs)

包含此代碼的工作簿中的已知工作表 ( ThisWorkbook )

Sub ExploreFolder()

    Const iFolderPath As String = "D:\Documents\"

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
    Dim Code As String: Code = CStr(ws.Range("A1").Value)
    
    Dim dFolderPattern As String: dFolderPattern = iFolderPath & Code & "*"
    Dim dFolder As String: dFolder = Dir(dFolderPattern, vbDirectory)
    
    If Len(dFolder) > 0 Then
        wb.FollowHyperlink iFolderPath & dFolder
    Else
        MsgBox "A folder matching the pattern '" & dFolderPattern _
            & "' was not found.", vbCritical, "Explore Folder"
    End If
     
End Sub

ActiveSheet （不推薦）

Sub ExploreFolderActiveSheet()

    Const iFolderPath As String = "D:\Documents\"

    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim Code As String: Code = CStr(ws.Range("A1").Value)
    
    Dim dFolderPattern As String: dFolderPattern = iFolderPath & Code & "*"
    Dim dFolder As String: dFolder = Dir(dFolderPattern, vbDirectory)
    
    If Len(dFolder) > 0 Then
        ws.Parent.FollowHyperlink iFolderPath & dFolder
    Else
        MsgBox "A folder matching the pattern '" & dFolderPattern _
            & "' was not found.", vbCritical, "Explore Folder"
    End If
     
End Sub