En poursuivant votre navigation sur ce site, vous acceptez l'utilisation de cookies pour vous proposer des contenus et services adaptés. Mentions légales.

Recherche

Recherche

Les mémos

Je débute...

Visites

 1222927 visiteurs

 7 visiteurs en ligne

Nous contacter

Contact

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

Catégorie : Les mémos - Fichiers
Page lue 6887 fois
Vous êtes ici :   Accueil » Rechercher un répertoire