Autres Faire une recherche de sous-dossiers Windows (pas de fichiers) dans un dossier précis à partir de son nom contenu dans une cellule

[Michou9]

Bonjour à tous
J'ai un fichier Excel (environ 500 lignes actuellement)
Dans la colonne A sont contenus des noms de sous dossiers
Je souhaiterais pouvoir faire une recherche de ces sous-dossiers Windows dans un dossier précis à partir de ces noms contenus dans les cellules de cette colonne
Les noms de ces sous-dossiers sont assez long
Je suis sous Excel 2007
Je ne sais pas si c'est réalisable ?
Je viens chercher de l'aide
Merci par avance

 

[job75]

Si ce n'est pas compliqué, je souhaiterais avoir à droite
donc dans la colonne B, directement le nom du nom avec le chemin, sans avoir à cliquer dessus

Dans ce cas autant mettre le chemin d'accès complet en colonne A, le code est plus simple :

Option Compare Text 'la casse est ignorée
Dim chemin$, fso As Object, a$(), n& 'mémorise les variables

Sub CheminDossierGeneral()
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Sélectionnez le Dossier Général"
    If .Show = False Then End
    [B10] = .SelectedItems(1) 'stockage en B10
End With
End Sub

Sub CheminsDossiers()
If fso Is Nothing Then
    chemin = [B10]
    If Replace(Dir(chemin, vbDirectory), ".", "") = "" Then MsgBox "Le chemin en B10 n'est pas valide !", 48: Exit Sub
    Set fso = CreateObject("Scripting.FileSystemObject")
End If
CheminsDossiersRecursive chemin
With [A12] '1ère cellule de destination
    If n Then .Resize(n) = Application.Transpose(a)
    .Offset(n).Resize(Rows.Count - n - .Row + 1).ClearContents 'RAZ en dessous
End With
Set fso = Nothing
Erase a: n = 0
End Sub

Sub CheminsDossiersRecursive(NomComplet$)
Dim sf As Object
For Each sf In fso.GetFolder(NomComplet).SubFolders
    If InStr(sf.Name, "€") Then
        ReDim Preserve a(n)
        a(n) = sf.Path
        n = n + 1
    End If
    CheminsDossiersRecursive sf.Path
Next sf
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [A12].Resize(Rows.Count - 11), Me.UsedRange) Is Nothing Then Exit Sub
Cancel = True
If Replace(Dir(Target, vbDirectory), ".", "") = "" Then MsgBox "Le chemin n'est pas valide !", 48: Exit Sub
Shell "explorer.exe """ & Target & """", vbNormalFocus 'ouvre le dossier
End Sub

 

[Michou9]

Je crois que cette fois c'est parfait
Mais il est tard (ou tôt?)
Je dois vous quitter
Je reviendrai demain sans faute
Après avoir transféré le code dans mon fichier
Bonsoir