Chemin d'accès dossier par nom dans cellule [XL-2010]

Bonjour,

Je cherche à retrouver le chemin d'accès d'un "DOSSIER" ou le critère est définit par le contenu d'une cellule. [s=co-c0504d][/s]

Je souhaite afficher le chemin d'accès dans une cellule adjacente (si possible en lien cliquable, mais pas sur que cela fonction si plusieurs lien sont dans la même cellule).

J'ai fait un petit fichier factice pour expliquer ce que je souhaite (malheureusement je ne peux pas donner les chemins d'accès, ceux-ci sont confidentiel).

Je pense que le VBA est indispensable (si jamais c'est possible autrement, je suis tout aussi preneur !)
N'hésitez pas à me poser des questions, ou à demande plus d'information.

ps :

La fonction

=CELLULE("nomfichier";A1)

...ne m'intéresse pas car elle renvoi le chemin d'accès du fichier en cours d'utilisation.

Merci pour votre attention, et votre lecture !

Bonjour,

Si vous voulez un lien cliquable, il ne sera pas possible de mettre les différents dossiers dans la même cellule comme présenté dans votre fichier

Bonsoir !

Oui effectivement, j'ai remarqué que cette requête était stupide...juste après avoir posté le sujet !

Avez-vous une petite idée concernant le reste ? Je n'ai pas précisé, mais cela concerne un fichier d'environ 1300 lignes. C'est pourquoi ce serait interressant pour moi

Bonjour à tous,

Est-ce que ma demande est trop complexe, ou bien est-elle juste passé à la trappe ?

N'hésitez pas à intervenir pour quelque raison, je me sentirais moins seul !

Bonjour à tous,

Voici une première tentative si j'ai bien compris le problème : renvoyer tous les répertoires contenant un mot clé se trouvant en A1 :

Public dico as object

Sub Filesearch()
srep$ = Environ("USERPROFILE") & "\Documents\" '<<< ADAPTER REPERTOIRE RACINE
set dico = createobject("Scripting.dictionary")
with activesheet.cells(1, 1) '<<< ADAPTER : CELLULE CONTENANT MOT CLE        
    Parcourir srep, .Value
    with .offset(, 1)
        .resize(.end(xldown).row - .row + 1).clearcontents
        if dico.count > 0 then .resize(dico.count) = application.transpose(dico.keys)
    end with
end with
set dico = nothing
End Sub

Function Parcourir(spath$, MotCle$)
Set fso = CreateObject("Scripting.filesystemobject")
Set ofolder = fso.getfolder(spath)
For Each osubfolder In ofolder.subfolders
    'If osubfolder.path Like "*" & MotCle & "*" Then dico(osubfolder.Path) = "" 'pour avoir tous les dossiers enfants qd corresp
    If osubfolder.name Like "*" & MotCle & "*" Then dico(osubfolder.Path) = "" 'pour avoir uniquement les dossiers corresp.
    Parcourir osubfolder.path, MotCle
Next osubfolder
End Function

Pour l'instant, la procédure respecte la casse. Il sera ensuite possible de gérer la question des hypertextes avec une macro évènementielle...

Ce genre de code peut prendre pas mal de temps...

Cdlt,

Bonjour 3GB,

Tout d'abord, merci à toi de t'intéresser à ce sujet !!

Tu as parfaitement compris. Même si la cellule A1 n'est qu'un exemple, je dois être capable de changer cela comme tu l'as indiquer dans ton code !

J'ai tenté d'appliquer ce cette première solution dans un extrait du fichier final que je souhaite utilisé (donc plus léger). Mais un problème auquel je ne m'attendais pas est apparu : lorsque j’exécute la fonction (directement dans Visual Basic), un message d'erreur apparait :"Permission refusée".

J'applique alors le débogage et voici la ligne qui renvient :

Lorsque j'utilise la fonction personnalisé "=Parcourir" directement dans la cellule concernée, cette dernière renvoi "#VALEUR!".

Je pense que la dessus tu vas pas pouvoir y faire grand chose. Je vais tout de même essayer de d'écrire mon identification sur le réseau pour t'aider :

Pour me connecter à mon espace, j'utilise une carte d'accès qui me permet d'aller sur n'importe quelle appareil. Dès que je me me connecte pour la 1ere fois, ce dernier "créer" une session sur l'ordinateur en question (comme si tu réinstallais Windows). J'accède ensuite simplement en insérant mon ID et en entrant un MDP.

Chaque "session" (bureau, documents....) est propre à l’ordinateur sur lequel je me trouve (il est donc possible que cela soit le problème ici). Lorsque je me connecte de nouveau, la "session" est déjà créée, donc je dois juste entrer mon ID et mon MDP.

En revanche, les lecteurs réseau que j'utilise se situent toujours sur K:\ et S:\

Et cela est également le cas pour l'ensemble de mes collègues. Je peux par exemple, leur envoyer un lien qui redirige vers un document se trouvant sur un de ces lecteurs, sans aucun soucis.

J'ai cependant accès qu'a une partie limité de ces lecteurs. cela est fait pour limiter l'accès aux données par n'importe qui.

L'idée finale de ce projet est de rechercher les-dits dossiers portant un nom défini dans une cellule (A1 par exemple) sur les deux lecteurs K:\ et S:\.

Merci pour votre aide à tous ceux qui passeront ici !

Salut YouniCornnn,

Je doute que la fonction marche sur la feuille et de toute façon, elle renverrait plusieurs données, d'où le recours à la procédure.

Peux-tu essayer de modifier le code ainsi :

Function Parcourir(spath$, MotCle$)
Set fso = CreateObject("Scripting.filesystemobject")
Set ofolder = fso.getfolder(spath)
For Each osubfolder In ofolder.subfolders
    if osubfolder.attributes <= 33 then
        'If osubfolder.path Like "*" & MotCle & "*" Then dico(osubfolder.Path) = "" 'pour avoir tous les dossiers enfants qd corresp
        If osubfolder.name Like "*" & MotCle & "*" Then dico(osubfolder.Path) = "" 'pour avoir uniquement les dossiers corresp.
        Parcourir osubfolder.path, MotCle
    end if
Next osubfolder
End Function

Il faut définir un répertoire et non un lecteur dans le code sinon, je doute que ça fonctionne.

Je ne peux vraiment pas tester en condition réelle.

Mais s'il est question d'autorisation, j'ai peur de ne pas pouvoir faire grand chose de plus (j'essaierai quand même de me renseigner quand j'aurai un moment).

Tu devrais déjà faire des essais sur le lecteur C avant de tenter sur les autres.

Cdlt,

Il faut avoir une gestion d'erreurs pour l'accès aux dossiers avec accès restreint

ajout deux lignes

On error goto finParcourir

et etiquette finParcourrir avant End Function

Function Parcourir(spath$, MotCle$) 
Set fso = CreateObject("Scripting.filesystemobject") 
On error goto finParcourir
Set ofolder = fso.getfolder(spath) 
For Each osubfolder In ofolder.subfolders 
   if osubfolder.attributes <= 33 then 
   'If osubfolder.path Like "*" & MotCle & "*" Then dico(osubfolder.Path) = "" 'pour avoir tous les dossiers enfants qd corresp 
   If osubfolder.name Like "*" & MotCle & "*" Then dico(osubfolder.Path) = "" 'pour avoir uniquement les dossiers corresp. Parcourir osubfolder.path, MotCle 
   end if 
Next osubfolder
finParcourir:
 End Function

Je vous décris ce que j'ai vécu :

*lis le post de scraper* : "A cool peut être une autre piste", dis-je avec un ton neutre.

*ouvre le fichier et colle le code modifié* : "Oh ptn ça fonctionne !", m'exclamai-je avec joie.

*retourner sur le forum* : "je vais leur décrire ce que j'ai vécu, ça va les faire rire, ou alors je passerais pour un crétin", me dis-je dans ma tête.

Donc maintenant le seul soucis, c'est que je ne connais pas les arguments pour faire cette recherche sur les lecteurs réseaux (environ "USERPROFILE"..), et même les deux lecteur réseau en même temps.

Bonjour à tous,

Alors ça marche finalement ?

Voici un essai pour le problème des lecteurs :

Sub Filesearch()
Set fso = CreateObject("Scripting.filesystemobject")
set dico = createobject("Scripting.dictionary")
with activesheet.cells(1, 1) '<<< ADAPTER : CELLULE CONTENANT MOT CLE 
    for each odrive in fso.drives
        if odrive.driveletter like "[KS]" then
            srep$ = odrive.rootfolder.path
            Parcourir srep, .Value
        end if
    next odrive       
    with .offset(, 1)
        .resize(.end(xldown).row - .row + 1).clearcontents
        if dico.count > 0 then .resize(dico.count) = application.transpose(dico.keys)
    end with
end with
set dico = nothing
End Sub

Il est probablement possible de faire mieux...

Cdlt,

Bien le bonjour !

Effectivement, et même si tu n'y croyais pas vraiment le code (avec le complément de scraper) fonctionne sur C:\\.

Je viens de tester le dernier code que tu m'as transmis, et malheureusement rien ne se passe : je veux dire par là que la fonction s’exécute correctement il y a un effacement de la cellule là ou le chemin doit être écrit si trouvé, mais aucun chemin n'est trouvé.

N'est-il pas possible d'indiquer clairement au début sur quel disque réseau je souhaite que la macro travaille : j'ai plusieurs fois vu la fonction Dir = "C:\....." ; Si nous indiquions ici le chemin "S:\..." est-ce que cela fonctionnerait ?

ps : je n'ai pas eu l'occasion de te remercier pour ta réponse suite à ma longue réponse ^^' : alors merci de ton implication !

Salut YouniCornnn,

Il faudrait que tu exécutes le code au pas à pas (touche F8) pour voir ce qu'il se passe car avec la gestion d'erreurs, il est possible que la recherche s'arrête dès la racine...

Pour changer le lecteur actif, il existe l'instruction chdrive mais, ici, je pense qu'il vaut mieux rester sur le filesystemobject qui est complet et approprié pour ce genre d'opérations. Justement, je demande en début de code de regarder chaque lecteur et de ne retenir que ceux dont la lettre est K ou S.

Aussi, tu peux essayer sans la condition if osubfolder.attributes <=33 then (ou en remplaçant 33 par 48). https://docs.microsoft.com/fr-fr/office/vba/language/reference/user-interface-help/attributes-proper...

Et bien sûr, il faut un mot-clé qui soit trouvé dans l'arborescence...

Désolé, dès que je pourrai faire des essais, j'en ferai pour voir. Ce n'est pas quelque chose que je maitrise vraiment, je m'y exerce.

Cdlt,

hello,

Surtout ne t'excuse pas d'essayer, nous y allons à tâtons, ce qui me permet aussi d'entre-apercevoir le fonctionnement d'un code.

Je vais exécuter ce code pas à pas et je reposterais une réponse de ce qu'il ce passe.

Nous somme bien d'accord, que dans la fonction qui détermine le choix du mot clé ...Cells(n° ligne, n°c olonne) : il faut que j'indique la cellule qui contient le mot clé à rechercher. Et qu'ensuite je prévois une cellule de libre à sa droite pour que le résultat sorte à ce niveau ?

Mais:

Exemple 1 :

Ici j'aurais donc ...cells(2, 1) ?

Exemple 2 :

Pour la fonction =Parcourirr, comment doit-elle être mise en place ?

Je t'avoue que généralement je m'aide des fonction pour bien remplir les critères. mais ici, la fonction personnalisé ne m'en propose pas : logique).

Je teste le pas à pas et je reviens.

Suite pour le Pas à pas :

j'ai choisi l'option pas à pas détaillé sur ce code :

Public dico As Object
Sub Filesearch()
Set fso = CreateObject("Scripting.filesystemobject")
Set dico = CreateObject("Scripting.dictionary")
With ActiveSheet.Cells(2, 3) '<<< ADAPTER : CELLULE CONTENANT MOT CLE
    For Each odrive In fso.drives
        If odrive.driveletter Like "[KS]" Then
            srep$ = odrive.rootfolder.Path
            Parcourir srep, .Value
        End If
    Next odrive
    With .Offset(, 1)
        .Resize(.End(xlDown).Row - .Row + 1).ClearContents
        If dico.Count > 0 Then .Resize(dico.Count) = Application.Transpose(dico.keys)
    End With
End With
Set dico = Nothing
End Sub

'Sub Filesearch()
'srep$ = Environ("USERPROFILE") & "\Documents\" '<<< ADAPTER REPERTOIRE RACINE
'Set dico = CreateObject("Scripting.dictionary")
'With ActiveSheet.Cells(4, 3) '<<< ADAPTER : CELLULE CONTENANT MOT CLE
    'Parcourir srep, .Value
    'With .Offset(, 1)
        '.Resize(.End(xlDown).Row - .Row + 1).ClearContents
        'If dico.Count > 0 Then .Resize(dico.Count) = Application.Transpose(dico.keys)
    'End With
'End With
'Set dico = Nothing
'End Sub
'''''''''''''Maccro qui fonctionne sur C:\

Function Parcourir(spath$, MotCle$)
Set fso = CreateObject("Scripting.filesystemobject")
On Error GoTo finParcourir
Set ofolder = fso.getfolder(spath)
For Each osubfolder In ofolder.subfolders
   If osubfolder.Attributes <= 33 Then
   'If osubfolder.path Like "*" & MotCle & "*" Then dico(osubfolder.Path) = "" 'pour avoir tous les dossiers enfants qd corresp
   If osubfolder.Name Like "*" & MotCle & "*" Then dico(osubfolder.Path) = "" 'pour avoir uniquement les dossiers corresp. Parcourir osubfolder.path, MotCle
   End If
Next osubfolder
finParcourir:
 End Function

Je lance et cela ce stoppe à

Sub Filesearch()

Et ensuite à plusieurs autres endroit, environ 20 arrêts de plus. J'avais commencé à noter les arrêts, mais j'ai l'impression que cela change une fois que j'ai fais une première boucle.

Dites-moi si je peux faire autre chose pour vous aider à m'aider

Bonjour YouniCornnn, 3GB

Si de besoin

Pour sélectionner un fichier quelque soit les disques (locaux ou réseaux) (je vous quitte jusqu'à 17h). Je vous suggère de créer une module et d'utiliser la fonction OpenDialogFile

#If Win64 Then
Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As Long
Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare PtrSafe Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
#Else
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
#End If

Private Type OPENFILENAME
    lStructSize As Long
#If VBA7 Then
    hwndOwner As LongPtr
    hInstance As LongPtr
#Else
    hwndOwner As Long
    hInstance As Long
#End If
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
#If VBA7 Then
    lCustData As LongPtr
    lpfnHook As LongPtr
#Else
    lCustData As Long
    lpfnHook As Long
#End If
    lpTemplateName As String
End Type

Public Const OFN_READONLY = &H1
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_SHOWHELP = &H10
Public Const OFN_ENABLEHOOK = &H20
Public Const OFN_ENABLETEMPLATE = &H40
Public Const OFN_ENABLETEMPLATEHANDLE = &H80
Public Const OFN_NOVALIDATE = &H100
Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Const OFN_PATHMUSTEXIST = &H800
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_CREATEPROMPT = &H2000
Public Const OFN_SHAREAWARE = &H4000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOTESTFILECREATE = &H10000
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOLONGNAMES = &H40000                      '  force no long names for 4.x modules
Public Const OFN_EXPLORER = &H80000                         '  new look commdlg
Public Const OFN_NODEREFERENCELINKS = &H100000
Public Const OFN_LONGNAMES = &H200000                       '  force long names for 3.x modules

Public Const OFN_SHAREFALLTHROUGH = 2
Public Const OFN_SHARENOWARN = 1
Public Const OFN_SHAREWARN = 0

Public Function OpenDialogFile(filter As String, Title As String, InitDir As String) As String

    Dim ofn As OPENFILENAME
    Dim A As Long
    ofn.lStructSize = LenB(ofn)
    ofn.hwndOwner = GetActiveWindow        'or Me.hwnd in VB
    ofn.hInstance = 1       'or App.hInstance in VB
    If Right$(filter, 1) <> "|" Then filter = filter + "|"
    For A = 1 To Len(filter)
        If Mid$(filter, A, 1) = "|" Then Mid$(filter, A, 1) = Chr$(0)
    Next
    ofn.lpstrFilter = filter
    ofn.lpstrFile = Space$(254)
    ofn.nMaxFile = 255
    ofn.lpstrFileTitle = Space$(254)
    ofn.nMaxFileTitle = 255
    ofn.lpstrInitialDir = InitDir
    ofn.lpstrTitle = Title
    ofn.flags = OFN_HIDEREADONLY Or OFN_FILEMUSTEXIST
    A = GetOpenFileName(ofn)

    If (A) Then
        OpenDialogFile = Trim$(ofn.lpstrFile)
    Else
        OpenDialogFile = ""
    End If

End Function

Salut Scraper,

Ce que tu propose s'intègre à quel moment dans le code que 3GB et toi m'avez construit ?

Je vais surement vous laisser discuter entre vous, mais juste pour rappel : tu sembles utiliser ce code pour trouver un fichier. Dans mon cas c'est la recherche de Dossier directement.

Perso, je suis disponible tous les jours entre 7h30 et 15h15 pour effectuer les tests sur mon lieu de travail, autrement, je ne pourrais pas (je n'ai pas de lecteur réseau chez moi).

A+

Oui, j'étais à côté de la plaque

Sélectionner un dossier

Function SelectionnerDossier()
Dim dlgFolder As FileDialog
Set dlgFolder = Application.FileDialog(msoFileDialogFolderPicker)
With dlgFolder
.InitialFileName = ThisWorkbook.Path
If .Show = -1 Then ' Clic sur Ok
SelectionnerDossier = .SelectedItems(1)
Else
' Clic sur Annuler
End If
End With
End Function

Salut YouniCornnn, scraper,

Oui, tu as bien compris mais je pense qu'il ne faut pas essayer d'utiliser cette fonction sur feuille directement. Déjà, il faut qu'on la fasse marcher en l'appelant par la macro et de toute façon une procédure me semble plus indiquée dans ce cas précis.

J'ai l'impression que tu as rencontré des erreurs de compilation, probablement dues à la présence de l'Option Explicit et à la non déclaration de toutes les variables ou à la présence de 2 macros du même nom. Mais il ne s'agit pas d'un bug à première vue, d'autant plus que tu nous as dit que la macro avait marché sur le disque C.

Voici le code sans la condition et sans la gestion d'erreurs :

Public dico As Object
Sub Filesearch()
Set fso = CreateObject("Scripting.filesystemobject")
Set dico = CreateObject("Scripting.dictionary")
With ActiveSheet.Cells(2, 1) '<<< ADAPTER : CELLULE CONTENANT MOT CLE
    For Each odrive In fso.drives
        If odrive.driveletter Like "[KS]" Then
            srep$ = odrive.rootfolder.Path
            Parcourir srep, .Value
        End If
    Next odrive
    With .Offset(, 1)
        .Resize(.End(xlDown).Row - .Row + 1).ClearContents
        If dico.Count > 0 Then .Resize(dico.Count) = Application.Transpose(dico.keys)
    End With
End With
Set dico = Nothing
End Sub

Function Parcourir(spath$, MotCle$)
Set fso = CreateObject("Scripting.filesystemobject")
Set ofolder = fso.getfolder(spath)
For Each osubfolder In ofolder.subfolders
   'If osubfolder.Attributes <= 48 Then
       If osubfolder.Name Like "*" & MotCle & "*" Then dico(osubfolder.Path) = ""
       Parcourir osubfolder.path, MotCle
    'end if
Next osubfolder
End Function

Il faut que tu le testes au pas à pas et que tu suives l'évolution :

1) est-ce que tu passes la condition

If odrive.driveletter Like "[KS]" Then

et par conséquent appelle la fonction.

2) le cas échéant, où bloque la fonction ?

3) En cas de bug, il faut que tu regardes les propriétés des objets : odrive, ofolder, osubfolder. Il faudrait que tu essaies d'analyser celles qui auraient un rôle à jouer dans le refus de permission (isready, attributes, peut-être d'autres).

C'est ce que je ferais pour l'instant, faute d'en savoir plus. Si tu rentres dans la fonction, la moitié du chemin est faite. Je pense alors qu'il vaudra mieux enlever la gestion d'erreurs (surtout pour les essais) et trouver la "bonne" condition.

Cdlt,

Bien le bonjour à vous deux !

Ce message est composé de deux parties : j'avais commencer une réponse avant de tester quelque chose de nouveau, donc la partie la plus à jours se situe en 2ème)
ps : le fichier est à jour même si il se situe dans la 1ère partie

Alors, je ne sais pas si je m'y prend correctement pour le pas à pas : quand j'utilisais cette fonction, la 1ere ligne est systématiquement en surbrillance (je pensais que cela voulais dire que l'erreur venait de cette ligne. Mais aujourd'hui j'ai des doute.

Pour le code :

Public dico As Object
Sub Filesearch()
Set fso = CreateObject("Scripting.filesystemobject")
Set dico = CreateObject("Scripting.dictionary")
With ActiveSheet.Cells(2, 3) '<<< ADAPTER : CELLULE CONTENANT MOT CLE
    For Each odrive In fso.drives
        If odrive.driveletter Like "[KS]" Then
            srep$ = odrive.rootfolder.Path
            Parcourir srep, .Value
        End If
    Next odrive
    With .Offset(, 1)
        .Resize(.End(xlDown).Row - .Row + 1).ClearContents
        If dico.Count > 0 Then .Resize(dico.Count) = Application.Transpose(dico.keys)
    End With
End With
Set dico = Nothing
End Sub

Function Parcourir(spath$, MotCle$)
Set fso = CreateObject("Scripting.filesystemobject")
Set ofolder = fso.getfolder(spath)
For Each osubfolder In ofolder.subfolders
   'If osubfolder.Attributes <= 48 Then
       If osubfolder.Name Like "*" & MotCle & "*" Then dico(osubfolder.Path) = ""
       Parcourir osubfolder.Path, MotCle
    'end if
Next osubfolder
End Function

En le lancent en mode "normal", ça a un peu planté ("Excel ne répond pas"), mais j'ai laissé tourner : et au bout d'un moment une erreur arrive "erreur 76" Chemin d'accès introuvable et cela sur la ligne

For Each osubfolder In ofolder.subfolders

Avec le pas à pas, je n'ai aucun message d'erreur, mais c'est toujours a première ligne qui apparait en surbrillance :

Sub Filesearch()

....avec ensuite plusieurs autres.

J'ai également remarqué qu'en écrivant un texte dans la cellule qui devrais ressortir le chemin d'accès, cette dernière n'est jamais effacé.

Je voulais m'assurer que vous ayez toutes les cartes en mains, car je ne suis pas certain de ce que je fais dès que l'on parle de VBA. J'ai essayé de regarde un tuto sur le pas à pas, et je crois faire les bonnes manipulations.

N'existe-t-il pas un moyen de générer un rapport d'erreur lorsque l'on test une macro afin de faire remonter les infos ? Cela pourrait peut-être me permettre de vous faire part des erreurs que je rencontre.

Aussi, je vous fais part du fichier sur lequel je test les différentes macros. Je l'ai anonymisé, par contre dès lors que je tente de taper quelque chose dans une cellule, l'erreur "nom ambigu" apparait. je clique sur "OK" et tout va bien (mais ce n'est pas important pour le moment)...

J'espère que vous avez tous les éléments, je ne souhaitais pas écrire un roman, mais au moins tout mon ressenti est là

___________________________LA PARTIE QUI EST LA PLUS A JOUR____________________

Attendez ! Ne partez pas, j'ai fais un truc de fou : j'ai cru comprendre qu'il y avait une préférence à activer dans les préférences (de VBA). J'ai activé le 'Microsoft Scripting Runtime Option'. Et là ! Surprise !

Sur le code [du module 2] (car celui du [module 1] fait limite crasher Excel) :

Public dico As Object
Sub Filesearch()
Set fso = CreateObject("Scripting.filesystemobject")
Set dico = CreateObject("Scripting.dictionary")
With ActiveSheet.Cells(2, 3) '<<< ADAPTER : CELLULE CONTENANT MOT CLE
    For Each odrive In fso.drives
        If odrive.driveletter Like "[KS]" Then
            srep$ = odrive.rootfolder.Path
            Parcourir srep, .Value
        End If
    Next odrive
    With .Offset(, 1)
        .Resize(.End(xlDown).Row - .Row + 1).ClearContents
        If dico.Count > 0 Then .Resize(dico.Count) = Application.Transpose(dico.keys)
    End With
End With
Set dico = Nothing
End Sub

Function Parcourir(spath$, MotCle$)
Set fso = CreateObject("Scripting.filesystemobject")
On Error GoTo finParcourir
Set ofolder = fso.getfolder(spath)
For Each osubfolder In ofolder.subfolders
   If osubfolder.Attributes <= 33 Then
   'If osubfolder.path Like "*" & MotCle & "*" Then dico(osubfolder.Path) = "" 'pour avoir tous les dossiers enfants qd corresp
   If osubfolder.Name Like "*" & MotCle & "*" Then dico(osubfolder.Path) = "" 'pour avoir uniquement les dossiers corresp. Parcourir osubfolder.path, MotCle
   End If
Next osubfolder
finParcourir:
 End Function

Ça fonctionne !!!!!!!!! Bon attention, ça fonctionne pour un dossier parent : qui se situe sur la racine du K:\.

Dès que je cherche un dossier 1 niveau en dessous, rien ne se passe.