Prova una cosa del genere:

codice:
Sub CercaPartFolder()
Dim subf() As String, nome_cartella As String, path As String, cartella_presente As Boolean, file_name As String

path = "Z:\ArchivioCommesse\_comm 2011\"
file_name = "prova.xls"

Set FSO = CreateObject("Scripting.FileSystemObject")
Set sf = FSO.GetFolder(path)
Set fc = sf.SubFolders

commessa = InputBox("Inserire il nome della commessa:", "Nome commessa")

    For Each f1 In fc
    ReDim Preserve subf(i)
        subf(i) = f1.name
        i = i + 1
    Next
    
cartella_presente = False
    
    For i = 0 To UBound(subf)
        'Debug.Print subf(i)
        If InStr(1, subf(i), commessa) = 1 Then
            nome_cartella = subf(i)
            cartella_presente = True
            Exit For
        End If
    Next
If cartella_presente = False Then
    a = MsgBox("Nessuna cartella corrispondente trovata")
    Else
    Workbooks.Open (path & "\" & nome_cartella & "\" & file_name)
End If
End Sub