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

[Emmanuel31]

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]

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

Heu...
Ainsi ?

Sub MAJ()
  'Appelle la procédure de recherche des fichiers
UserForm1.Show 0
 ListeFichiers [Parametres!A2]
Unload UserForm1
  MsgBox "Mise à jour des liens terminée"
End Sub
Sub ListeFichiers(Repertoire As String)
    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 = [A1]: Set d = [A500].End(xlUp)(2, 1)
'Boucle sur tous les noms de fichiers de la colonne A
Do While c.Address <> d.Address
  UserForm1.Label1.Caption = "% effectué : " & format(100 * (c.Row - 6) / (d.Row - 6), 0.00)
  Userform1.Repaint
   
'Si la cellule n'est pas vide et dont la valeur commence par un "1"
If c <> "" And Left(c, 1) = "1" Then
For Each FileItem In SourceFolder.Files
  'Si la cellule ne contient pas de lien hypertexte
If c.Hyperlinks.Count = 0 Then
        If FileItem.Name Like "*" & c & "*" & [Parametres!A4] Then
            'Ajoute un lien hypertexte vers le fichier
       ActiveSheet.Hyperlinks.Add Anchor:=c, _
              Address:=FileItem.ParentFolder & "\" & FileItem.Name
        End If
  'Si la cellule contient un lien hypertexte contenant le chemin "TEST A VALIDER"
ElseIf InStr(UCase(c.Hyperlinks(1).Address), "\TEST A VALIDER\") > 0 Then
        If FileItem.Name Like "*" & c & "*" & [Parametres!A4] Then
            'Remplace le lien hypertexte vers le chemin définitif
       ActiveSheet.Hyperlinks.Add Anchor:=c, _
              Address:=FileItem.ParentFolder & "\" & FileItem.Name
        End If
 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]

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

Merci ça fonctionne !

Ca va 1 fois à 100% puis ça refait rapidement un compte de 1 à 100% et ça termine.
Par contre j'ai remarqué que si j'allais sur une autre fenêtre de mon pc (un word par exemple), quand je reviens sur l'excel, le userform est "figé" en attendant la fin du traitement (plus de mise à jour visuelle du décompte).

De plus j'ai essayé de modifier le texte en faisant :

 UserForm1.Label1.Caption = "Mise à jour en cours : " & Format(100 * (c.Row - 6) / (d.Row - 6), 0# & " % effectués ")

mais du coup il va de 1 à 10000% ... !!

 

[pasquetp]

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

Bonjour,

voila j'ai essayé. la macro se lance bien et me met terminé sauf qu'il me propose rien. le chemin est bon et lextension est bonne (j'ai tenté xls et xlsx) et j'ai mis des chiffres bidons genre 1 et pourtant il me trouve rien. une explication???

Merci d'avance

ps: pour améliorer la simplicité de ce programme, je suggere qu'il faudrait creer un useform et mettre les champs a remplir afin d'éviter d'éventuel erreurs
juste une idée.

 

[Emmanuel31]

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

ps: pour améliorer la simplicité de ce programme, je suggere qu'il faudrait creer un useform et mettre les champs a remplir afin d'éviter d'éventuel erreurs
juste une idée.

Mon but était justement de s'affranchir de cette étape et ne pas "polluer" le process avec cette saisie ...
D’où le fait de rentrer cela via un onglet "Parametres" ou les variables sont définies ...

 

[pasquetp]

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

ok

quant a mon pb, auriez vous une solution??? votre programme semble vraiment ingénieux et j'aimerai vraiment l'utiliser dans le cadre de mon travail

merci encore

 

[Softmama]

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

Bonjour,

@Emmanuel31 : Pour la ligne qui pose problème, essaie plutôt :

UserForm1.Label1.Caption = "Mise à jour en cours : " & Format(100 * (c.Row - 6) / (d.Row - 6), 0# ) & " % effectués "

@Pasquetp : Pour que cela fonctionne, il te faut modifier cette ligne :
ListeFichiers [Parametres!A2]
Ramplace la par:
ListeFichiers [B1]

puis remplace

        If FileItem.Name Like "*" & c & "*" & [Parametres!A4] Then

par

        If FileItem.Name Like "*" & c & "*" & [B2] Then

en notant dans ta feuille, en cellule B1, le chemin (par exemple C:\CHEMIN\EXEMPLES\EXCEL\) et en cellule B2, l'extension à chercher (par exemple .xlsx)

Dans ta colonne A, tu notes les parties de noms de fichiers à rechercher

 

[Emmanuel31]

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

@ Softmama : Merci, effectivement je m'était crouté sur la position de la parenthèse ;-)