Macro recherche de fichiers en fonction de chemin,texte,extension

Emmanuel31 · 1 Août 2011

Bonjour à toutes et à tous !

J'ai trouvé sur internet une macro qui permet de rentrer 3 paramètres (chemin, texte, extension) et ainsi en l'exécutant de créer un lien hypertexte du ou des fichiers avec l'extension demandée et contenant le texte demandé dans le chemin demandé.

En gros et pour faire simple si vous mettez :
- chemin : C:\test\
- texte : test1
- extension : .xls
la macro vous créra le ou les liens vers tous les fichiers excel dans C:\test contenant en titre le nom de test1

Là ou je sollicite votre aide, c'est concernant la modification de cette macro ...

Je souhaite faire fonctionner cette macro en boucle à partir de cellules contenant le texte à chercher.

c-a-d en
- A1 : le texte est "test1"
- A2 : le texte est "test2"
- A3 : le texte est "test3"

Le but étant d'avoir en B1 B2 et B3 les liens fichiers correspondants.

Y'a-t-il un expert dans le coin qui pourrait m'aider svp ?

Merci !

Softmama · 1 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

Bonjour,

vois si ceci répond à ton besoin (j'ai refait les macros, les tiennes me paraissaient trop compliquées pour ton besoin) :

VB:

Sub TestListeFichiers()
    
    'Définit le répertoire pour débuter la recherche de fichiers.
    '(Attention à ne pas indiquer un répertoire qu contient trop de sous-dossiers ou de
    'fichiers, sinon le temps de traitement va être très long).
    'Appelle la procédure de recherche des fichiers
    ListeFichiers [C2]
    
    MsgBox "Terminé"
End Sub
 
 
 
Sub ListeFichiers(Repertoire As String)
    '
    'Nécessite d'activer la référence "Microsoft Scripting RunTime"
        'Dans l'éditeur de macros (Alt+F11):
        'Menu Outils
        'Références
        'Cochez la ligne "Microsoft Scripting RunTime".
        'Cliquez sur le bouton OK pour valider.
    
    Dim Fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim SubFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim i As Long
    
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)
    
    'Récupère le numéro de la dernière ligne vide dans la colonne A.
    i = Range("B65536").End(xlUp).Row + 1
    
Set c = [A7]
'Boucle sur tous les noms de fichiers de la colonne A
Do While c <> ""
    'Boucle sur tous les fichiers du répertoire
    For Each FileItem In SourceFolder.Files
        If FileItem.Name Like "*" & c & "*" & [C4] Then
            'Inscrit le nom du fichier dans la cellule
            Cells(i, 2) = FileItem.Name
            'Ajoute un lien hypertexte vers le fichier
            ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 2), _
              Address:=FileItem.ParentFolder & "\" & FileItem.Name
            i = i + 1
        End If
    Next FileItem
    Set c = c(2, 1)
Loop
    
    '--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
    For Each SubFolder In SourceFolder.subfolders
        ListeFichiers SubFolder.Path
    Next SubFolder
 
End Sub

Emmanuel31 · 2 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

Merci beaucoup Softmama !!!

Par contre je me rends compte que dans ton fichier, si on exécute 2 fois, il n'y a pas de remise à 0 entre chaque exécution , et du coup tout se rajoute à la suite :-(

De plus, penses-tu qu'il est possible de carrément remplacer la valeur de la cellule initiale (valeur à chercher) par le même texte mais avec dessus un lien hypertexte vers le fichier ?

Softmama · 2 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

Bonjour,

Il te suffit de rajouter :
[B7:B65000].Clear

En début de macro

Softmama · 2 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

Pour la deuxième question , c'est possible mais je te ferai ça plus tard. J'ai pas d'ordinateur près de moi et je te réponds depuis mon téléphone là.

Emmanuel31 · 2 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

OK pas de soucis !
Merci encore et donc à très vite pour la suite (que j'attends avec délectation) ^^

Softmama · 2 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

Re,

alors à vue de nez, ceci devrait pouvoir le faire :

VB:

Sub TestListeFichiers()
   
    'Définit le répertoire pour débuter la recherche de fichiers.
   '(Attention à ne pas indiquer un répertoire qu contient trop de sous-dossiers ou de
   'fichiers, sinon le temps de traitement va être très long).
   'Appelle la procédure de recherche des fichiers
   ListeFichiers [C2]
   
    MsgBox "Terminé"
End Sub
 
 
 
Sub ListeFichiers(Repertoire As String)
    '
   'Nécessite d'activer la référence "Microsoft Scripting RunTime"
       'Dans l'éditeur de macros (Alt+F11):
       'Menu Outils
       'Références
       'Cochez la ligne "Microsoft Scripting RunTime".
       'Cliquez sur le bouton OK pour valider.
   
    Dim Fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim SubFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim i As Long
   
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)
   
Set c = [A7]
'Boucle sur tous les noms de fichiers de la colonne A
Do While c <> ""
    'Boucle sur tous les fichiers du répertoire
   For Each FileItem In SourceFolder.Files
        If FileItem.Name Like "*" & c & "*" & [C4] Then
            'Ajoute un lien hypertexte vers le fichier
           ActiveSheet.Hyperlinks.Add Anchor:=c, _
              Address:=FileItem.ParentFolder & "\" & FileItem.Name
        End If
    Next FileItem
    Set c = c(2, 1)
Loop
   
    '--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
   For Each SubFolder In SourceFolder.subfolders
        ListeFichiers SubFolder.Path
    Next SubFolder
 
End Sub

Par contre, si tu as plusieurs fichiers dans le répertoire renseigné en C2 (ou dans ses sous répertoires) qui contiennent la chaine de caractères noté en C3 et avec l'extension de C4 ( en gros si tu as un fichier noté :
C:\Test\test1.xls
et un fichier :
C:\Test\Secondtest1.xls
avec en C3: test1, le lien se fera uniquement sur le second fichier (On ne peut avoir qu'un lien par cellule

)... Je ne suis pas sur que c'est ce que tu souhaites ?
si tu connais précisément le nom du fichier test1.xls, le plus simple est de chercher la correspondance exacte. A ce moment, il suffit de remplacer la ligne avec le Like par :

Code:

        If FileItem.Name Like c  & [C4] Then

Emmanuel31 · 2 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

Les fichiers que je cherchent portent en fait un identifiant unique, et c'est bien celui là que je recherche donc pas de soucis !

Merci encore pour ton aide plus que précieuse !!!!

Emmanuel31 · 2 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

Arf , j'ai une erreur en utilisant ceci dans mon fichier ....

Une erreur sur "Fso As Scripting.FileSystemObject" ...
"Type défini par l'utilisateur non défini" ...

PS : j'avais pas lu le commentaire sur le Runtime Scripting ....

Softmama · 2 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

re,

Comme indiqué en commentaire dans la macro :

'Nécessite d'activer la référence "Microsoft Scripting RunTime"
'Dans l'éditeur de macros (Alt+F11):
'Menu Outils
'Références
'Cochez la ligne "Microsoft Scripting RunTime".
'Cliquez sur le bouton OK pour valider.

Il faut effectuer cette opération pour que la macro fonctionne. (une seule fois suffit)

Emmanuel31 · 2 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

Oui pardon ça marche nickel ...

Par contre, comme pour la mise en forme j'ai des lignes d'espaces, ça s'arrête :-(

Je vais chercher comment faire pour qu'il regarde la colonne A et que ce script ne s’exécute QUE sur les cellules comportant des chiffres dans la colonne A ....

(voir même plus tard une barre de progression car j'ai pas mal de ligne (100) et ça mets du temps ...)

Softmama · 2 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

<tu peux modifier comme suit :

VB:

Sub TestListeFichiers()
   
  'Appelle la procédure de recherche des fichiers
  ListeFichiers [C2]
  MsgBox "Terminé"
End Sub
 
 
 
Sub ListeFichiers(Repertoire As String)
    '
  'Nécessite d'activer la référence "Microsoft Scripting RunTime"
      'Dans l'éditeur de macros (Alt+F11):
      'Menu Outils
      'Références
      'Cochez la ligne "Microsoft Scripting RunTime".
      'Cliquez sur le bouton OK pour valider.
 
    Dim Fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim SubFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim c as Range, d as Range
   
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)
   
Set c = [A7]: Set d= [A65000].end(xlup)(2,1)
'Boucle sur tous les noms de fichiers de la colonne A
Do While c.address <> d.address
  if c<>"" then
    'Boucle sur tous les fichiers du répertoire
  For Each FileItem In SourceFolder.Files
        If FileItem.Name Like "*" & c & "*" & [C4] Then
            'Ajoute un lien hypertexte vers le fichier
          ActiveSheet.Hyperlinks.Add Anchor:=c, _
              Address:=FileItem.ParentFolder & "\" & FileItem.Name
        End If
    Next FileItem
    end if
    Set c = c(2, 1)
Loop
   
    '--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
  For Each SubFolder In SourceFolder.subfolders
        ListeFichiers SubFolder.Path
    Next SubFolder
 
End Sub

Emmanuel31 · 2 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

Nickel Merci !!!!
Décidément , t'es un vrai champion !!!

Allez, tant que je tiens, nouveau défi :
quand on lance le script une seconde fois, qu'il ne repasse pas sur les cellules qui ont déjà des liens (il ne mettra donc à jour que ce qui a été rajouté depuis, ça évite de repartir dans 5 minutes de traitement pour juste une ligne en plus ...)
^^

Softmama · 2 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

re,

en ce cas, modifie la ligne :

VB:

  if c<>"" then

par

VB:

  if c<>"" and c.hyperlinks.count=0 then

Emmanuel31 · 2 Août 2011

Re : Macro recherche de fichiers en fonction de chemin,texte,extension

Parfait !!!
Merci !!!

Par contre ça mets un peu moins de temps, mais toujours pas mal quand même ... et ce même en réduisant le champs de A65000 à A500 ...
Et ce même s'il n'y a qu'une nouvelle entrée à traiter, ou même pas du tout ...

En plus ça corrige un "bug" qui faisait que ça rajoutais au lien hypertexte à chaque ré-exécution de macro un /../ !!
Donc c'est nickel ... !

Je vais juste chercher un genre de module de barre de défilement pour faire patienter maintenant ;-)

Effectuez une recherche sur Excel Downloads...

Macro recherche de fichiers en fonction de chemin,texte,extension

Emmanuel31

XLDnaute Occasionnel

Pièces jointes

Softmama

XLDnaute Accro

Pièces jointes

Emmanuel31

XLDnaute Occasionnel

Softmama

XLDnaute Accro

Softmama

XLDnaute Accro

Emmanuel31

XLDnaute Occasionnel

Softmama

XLDnaute Accro

Emmanuel31

XLDnaute Occasionnel

Emmanuel31

XLDnaute Occasionnel

Softmama

XLDnaute Accro

Emmanuel31

XLDnaute Occasionnel

Softmama

XLDnaute Accro

Emmanuel31

XLDnaute Occasionnel

Softmama

XLDnaute Accro

Emmanuel31

XLDnaute Occasionnel

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums