XL 2019 Rechercher un fichier dans plusieurs répertoires

[qalibo30]

Bonjour à tous,
J'espère que vous allez bien malgré les évènements.
Voilà j'ai recherché dans les discussions sur le site une solution à ma recherche mais en vain.

Dans un fichier EXCEL, j'ai dans la colonne A, des noms dans les différentes cellules, qui correspondent à des noms de fichiers qui peuvent se trouver
dans des répertoires ou sous-répertoires différents sous C:\ (mais ca pourrait être dans tout autre disque)
Je souhaiterai en cliquant sur une cellule de la colonne A, que le fichier qui a le même nom et qui se trouve donc dans un autre répertoire ou sous répertoire puisse s'ouvrir.

J'ai mis le fichier en questione en pièce jointe dans lequel il y dans Feuil1, une macro qui fonctionne mais seulement si le chemin de recherche est stipulé (ex: chemin = "C:\Perso\Administratif\")

J'ai trouvé 2 exemples (Sub FileSearch() et Sub FileSearch2()) d'utilisation de "SearchSubFolders" que j'ai copié dans le Module 1 mais malgré mes tentatives, il y a un soucis avec l'utilisation de With Application.FileSearch


Merci pour votre aide.

 

[patricktoulon]

re
vu
c'est ni plus ni moins que la commande tree en fait je savais pas qu'il y avait une api pour ça je découvre
j'ai toujours utilisé un shell pour lancer la commande tree et diriger vers un fichier txt ou clip

c'est pas mal

Private Declare Function SearchTreeForFile Lib "imagehlp" (ByVal RootPath As String, ByVal InputPathName As String, ByVal OutputPathBuffer As String) As Long
Private Const MAX_PATH = 260


Private Function trouve(R As String, F As String, Ext As Variant) As String
    Dim T As String, resu As Long
    T = String(MAX_PATH, 0)
    For i = LBound(Ext) To UBound(Ext)
        F1 = F & Ext(i)
        resu = SearchTreeForFile(R, F1, T)
        If resu <> 0 Then
            trouve = Left$(T, InStr(1, T, Chr$(0)) - 1): Exit Function
        End If
    Next

End Function
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim MyFich$
    If Target.Column = 1 And Target.Count = 1 And Target.Value <> Empty Then
        Dim repertoire As String, fichier As String
        repertoire = "C:\Résultats\"
        fichier = Target.Text
        MsgBox trouve(repertoire, fichier, Array(".xls", ".xlsx", ".xlsm"))
    End If
End Sub    '

bon ben c'est vrai que si on part de la racine "C:\" ,c'est plus long et c'est normal il passe en revue tout les dossiers/fichiers qui sont un paquet sur "C:\"
d'ou mon intervention sur ce point précédemment ne rien mettre dans "C:\" et le laisser pour l'exploitation
Merci Jacques tu m'a donné un truc a faire la
je vais voir si il est possible de lister
ensuite je convertirais en api au black

 

[fanch55]

Bonjour fanch55
oui c'est vrai j'ai pas mis l’/ les extension qui sont possible
deja on remet les extensions désirées
maliste = liste_mes_Fichiers("C:\Résultats\",".xls",".xlsx",".xlsm") ' EXTENTION DEMANDE
je peux ajouter un argument de plus "fichier" avec le nom en cellule et y ajouter un like

Patrick, ne pas oublier les Xlsb non plus ....

 

[qalibo30]

Salut fanch55,
Ma problématique a été résolu mais ton fichier pourra me servir également.
Merci à toi

 

[fanch55]

Salut fanch55,
Ma problématique a été résolu mais ton fichier pourra me servir également.
Merci à toi

Je n'ai fait que participer sans fournir aucun fichier,
Je te remercie de me remercier .

N'oublies pas de marquer le Post qui t'a servi en tant que Solution .

 

[fanch55]

Salut, via les APIs à voir, élaguer etc, bref adapter à ton contexte

Salut @kiki29
J'ai testé ton fichier sur mon Office 64bits : plantage immédiat et violent, Excel se relance en mode récupération .
Bon, j'ai tracé le code et j'ai du faire qq modifs pour que cela fonctionne sur mon Excel 64bits :

#If Win64 Then
    Private Declare PtrSafe Function FindClose Lib "kernel32" _
            (ByVal hFindFile As LongPtr) As Long
    Private Declare PtrSafe Function FindFirstFile Lib "kernel32" _
            Alias "FindFirstFileA" _
            (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As LongPtr
    Private Declare PtrSafe Function FindNextFile Lib "kernel32" _
            Alias "FindNextFileA" _
            (ByVal hFindFile As LongPtr, lpFindFileData As WIN32_FIND_DATA) As Long
    Private Declare PtrSafe Function lstrlen Lib "kernel32" Alias "lstrlenW" _
            (ByVal lpString As LongPtr) As Long
    Private Declare PtrSafe Function PathMatchSpec Lib "shlwapi" _
            Alias "PathMatchSpecW" _
            (ByVal pszFileParam As LongPtr, ByVal pszSpec As LongPtr) As LongPtr
#Else
....

Private Sub SearchForFiles(sRoot As String)
Dim WFD As WIN32_FIND_DATA
#If Win64 Then
    Dim hFile As LongPtr
#Else
    Dim hFile As Long
#End If
....
......

Ma foi, c'est très rapide, j'ai mis mon disque Documents en root ( pas système ) : près de 32000 fichiers en 19 sd pour un disque local .

132467 fichiers sur un disque réseau serveur en 2mn30 , c'est largement tolérable ..

C'est dommage que les fichiers soient présentés en "Full name" et non pas en arborescence, j'ai des fichiers à rallonge .... mais je chipote ...

 

[fanch55]

Pour les curieux et sans atténuer ma mise en garde, voici (exemple) ce qu'utilise Microsoft dans certains cas :

Salut, testé votre code :

Pour le même type de recherche :
C'est quasi immédiat sur un disque local .
Cela prend 9 secondes sur un disque réseau monté avec une lettre
Cela ne fonctionne pas sur le même disque en montage serveur \\serveur\.....

c'est une recherche de fichier et on s'arrête sur le premier fichier correspondant .
ce n'est pas comparable en l'état au code de Kiki29 qui liste tous les fichiers et dossiers .

Cependant après modif de son code pour qu'il s'arrête à la première occurrence aussi,
Il lui faut 13 secondes pour trouver le même fichier sur un disque réseau
et 2 secondes sur un disque local .

Pour résumer, le code utilisé par Microsoft est le plus rapide mais ne fonctionne pas avec un disque pur réseau .

Voili, voilà, on en fait ce qu'on veut ...
C'était juste par curiosité ...