Rechercher un répertoire

Rechercher un répertoire et obtenir son chemin d'accès

Placez la fonction suivante dans un module général, onglet Module et que vous nommerez "mod_RechercheRepertoire" par exemple.

Remarque :

Le chemin retourné, est celui qui mène au premier répertoire trouvé.

Si donc vous cherchez le répertoire "Test" dont il existe deux exemplaires, vous obtiendrez par exemple "C:\Niveau1\Test" et jamais "C:\Niveau1\Niveau2\Test".

Function fnSearchFolder(StartPath As String, FolderName As String)
    '//
    '//     Syntaxe :
    '//     Chemin = fnSearchFolder("C:\","MonRepertoire")
    '//     Chemin = fnSearchFolder("D:\Images","MonRepertoire")
    '//
    On Error GoTo Err_SearchFolder
    Dim boFound As Boolean
    Dim i As Integer, j As Integer, MaxRep As Integer
    Dim Path2Folder() As String
    Dim sFind As String
    Const vbDir As Integer = vbDirectory

    If Right(StartPath, 1) <> "/" Then StartPath = StartPath & "/"
    FolderName = Replace(FolderName, "/", "")
    i = 1: j = 0: MaxRep = 0: boFound = False
    ReDim Path2Folder(100)
    Path2Folder(0) = StartPath
    sFind = Dir(StartPath, vbDir)
    Do While (Path2Folder(j) <> "") And (boFound = False)
        Do While (sFind <> "") And (boFound = False)
            If sFind <> "." And sFind <> ".." Then
                If (GetAttr(Path2Folder(j) & sFind) And vbDir) = vbDir Then
                    If i > (MaxRep - 5) Then
                        MaxRep = i + 100
                        ReDim Preserve Path2Folder(MaxRep)
                    End If
                    Path2Folder(i) = Path2Folder(j) & sFind & "/"
                    If Right(Path2Folder(i), Len(FolderName) + 2) = _
                       ("/" & FolderName & "/") Then
                        fnSearchFolder = Path2Folder(i)
                        boFound = True
                    End If
                    i = i + 1
                End If
            End If
            sFind = Dir
        Loop
        j = j + 1
        sFind = Dir(Path2Folder(j), vbDir)
    Loop

Exit_SearchFolder:
    Exit Function
Err_SearchFolder:
    If Err.Number <> 52 Then
        MsgBox Err.Number & " " & Err.Description
    End If
    Resume Exit_SearchFolder
End Function