VBA - How to open folder without knowing the full name

user_19189750 0
Viewed 89

I'm trying to open a folder where I don't know the full path.

For example, the parent folder dir is "D:\Documents" and the folder I want to open is called "22.111 - PROJECT_NAME", where I know the code, but don't know the name. I've tried with "*", but no luck.

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
ms-access vba excel
3 Answers

Found the answer on another forum (mrexcel.com), leaving it below for anyone that faces the same problem:

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
user_191897500

With the parent folder available and the knowledge that the subfolder starts with 22.111, you could loop through all subfolders in the parent folder, and list all the potential matches using InStr. Example of how you might do this:

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

If you want to use RegEx, you might want to look at How do i use regex using instr in VBA.

user_184706920

Explore a Folder Using Workbook.FollowHyperlink

A Known Worksheet in the Workbook Containing This Code (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 (not recommended)

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
user_98140690
Related