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

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

例如，父檔案夾 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

uj5u.com熱心網友回復：

在另一個論壇 (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

uj5u.com熱心網友回復：

有了可用的父檔案夾和子檔案夾以 開頭的知識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。

uj5u.com熱心網友回復：

使用瀏覽檔案夾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

標籤：擅长 vba 毫秒访问

上一篇：有人可以幫我寫一個查詢來確定哪支球隊輸掉了一場比賽，以及一個單獨的查詢來計算每支球隊的損失

下一篇：SQL查詢顯示2個不同表的行