Discussion :

[Vadorblanc]

Bonjour
La recherche d'un fichier particulier dont on n'a perdu son emplacement m'oblige à lister le contenu d'une arborescence de dossier et de fichiers, ma seule solution aujourd'hui est de lancer une commande DOS par Exécuter: cmd:C:Documents and Setting\Dossier>tree/C C:Public>liste.xls
J'ai ensuite ce fichier Excel "Liste.xls" dont je remplace certaines lettres par des lettres accentuées par Rechercher Remplacer dont je pourrais automatiser la tâche par une macro.
J'ai maintenant la liste de tous mes fichiers correctement nommées avec leurs emplacement dans l'arborescence (plusieurs milliers).
Par 'Rechercher' je trouve aussi facilement le fichier dont j'avais perdu une partie de son nom ansi que son emplacement.
Voilà ma demande sur le forum:
Comment avoir une macro qui puisse quand on a trouvé le fichier par Rechercher ... ouvrir le fichier directement sans devoir se faufiler dans toute l'arborescence pour le retrouver (car il faut annoter toutes l'arborescence sur un papier puis suivre tout le chemin), comme avoir par exemple un lien hyper texte qui pointe directement dessus.
Je précise que l'arborescence que je décrits est composée de 4 gros dossiers qui contiennent des sous dossiers avec des fichiers, puis des sous dosssiers, etc...
Voilà, est ce réalisable?
Merci

[tedo01]

Bonjour,
Je vois 2 solutions :

1. Créer un bouton ou menu qui lance le code suivant : il faut être placé dans la cellule contenant le nom du fichier et la macro l'ouvre.

   Code :

   Sélectionner tout - Visualiser dans une fenêtre à part

   Workbooks.Open ActiveCell.Value

2. Créer des hyper-liens sur chaque fichier avec :ActiveSheet.Hyperlinks.Add

Tout dépend de la manière dont tu préfère utiliser le résultat

[Vadorblanc]

Bonjour tedo01
J'ai essayé ta première solution mais j'ai le message m'indiquand fichier introuvable, et ta deuxième solution avec le lien hypertecte je n'arrive pas la mettre en place.
Merci

[tedo01]

Re,
Est-ce que tu peux joindre un fichier exemple ? Ma première solution part du principe que le contenu de ActiveCell est le nom complet (avec le chemin) du document.

[Vadorblanc]

tedo01,
Pour ta première solution, je sélectionne le fichier Essai2.xls, je lance ton code, et j'ai le message:
Erreur d'exécution 1004
'Essai2.xls' introuvable
Vérifier l'orthographe du nom du classeur et de la validité de l'emplacement
Si vous essayer d'ouvrir le fichier à partir de la liste des fichiers les plus récents, assurez vous que le fichier n'a pas été renommé, déplacé ou supprimé.

En fait à la sortie de la commande DOS, le fichier est un fichier TEXTE que je suis obligé de l'enregistrer au format xls car je lui mets le code proposé.
Merci

[tedo01]

OK, c'est normal que ça ne fonctionne pas. J'avais cru comprendre que ta liste Excel contenait déjà l'emplacement de chaque fichier, c'est ce qu'il faut pour ouvrir un classeur...
Il faut un travail conséquent pour coder une macro qui devra décortiquer la liste pour reconstituer tout le chemin d'un fichier !
Je n'ai pour le moment pas le temps de le faire, si personne ne prend le relais je regarderai ça dans quelques jours...
Sorry :-(

[Vadorblanc]

Merci tedo01 pour tes essais.
Par contre je viens de me rendre compte qu'en copiant le nom du fichier pour le mettre dans l'assistant de recherche de Windows, le résultat en cliquant sur le fichier trouvé l'ouvre aussi très rapidement, j'en déduis qu'il faudrait qu'une macro puisse ouvrir directement l'assistant Recherche de windows...

[patricktoulon]

bonjour le plus simple serai de faire une macro qui te cherche le fichier en question et te l'ouvre directement sa serait bien ca hein!!!!


et bien tiens voila
dans cet exemple j'ai placé un fichier "toto.xls" dans un sous dosier qui lui meme dans un dossier nomé "patrick" ce qui veu dire que cette macro recherche dmeme dans les sous dossiers et ouvre le fichier

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
 
Option Explicit
Public nb As Integer
 
Sub Appel()' cette macro chez moi je l'apelle, avec un bouton sur mon sheets
Dim chemin As String
    nb = 0
    chemin = "F:\PATRICK"
    Lister chemin
End Sub
 
 
 
 
Public Function Lister(chemin As String)
Dim fs, Rep As Variant, NewRep As String, Nomfich As String
    Set fs = CreateObject("Scripting.FileSystemObject")
    Lister = fs.GetFolder(chemin).Files.Count
    Nomfich = Dir(chemin & "\*.xls")
    Do While Nomfich <> ""
        nb = nb + 1
        If Nomfich = "toto.xls" Then Workbooks.Open chemin & "\" & Nomfich
 
 
        Nomfich = Dir()
    Loop
    'Pour chaque sous-répertoire, appel récursif de Lister
    For Each Rep In fs.GetFolder(chemin).SubFolders
        NewRep = Lister(Rep.Path)
    Next Rep
End Function

j'espere que ca te sera utile

au plaisir

[Vadorblanc]

Bonjour patricktoulon
Je ne pensais plus avoir de réponse car ça me paraissait assez compliqué, certainement par mon explication lourde, mais je vois que tu as très bien apporté une solution avec ton code qui fonctionne très bien pour le fichier écrit dans la macro, super.
Dans l'essai que j'ai testé je n'ai mis que 2 sous répertoire, car en réalité sur mon travail il y en a des multitudes, penses tu que cela fonctionnera aussi ? je trouve ce code surprenant.
Mais serait il possible maintenant qu'en mettant la sélection sur le nom du fichier par exemple en A10, et qu'avec une touche raccourci du clavier pour lancer ta macro j'arrive directement sur le fichier, je pense une touche raccourci car si je clique sur le bouton lancement de la macro je perde la sélection du fichier.
Merci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Option Explicit
Public nb As Integer
 
Sub Appel() ' cette macro est à lancer avec un bouton sur la sheets
Dim chemin As String
    nb = 0
    chemin = "C:\ESSAI"
    Lister chemin
End Sub
 
 
 
 
Public Function Lister(chemin As String)
Dim fs, Rep As Variant, NewRep As String, Nomfich As String
    Set fs = CreateObject("Scripting.FileSystemObject")
    Lister = fs.GetFolder(chemin).Files.Count
    Nomfich = Dir(chemin & "\*.xls")
    Do While Nomfich <> ""
        nb = nb + 1
        If Nomfich = "Essai3.xls" Then Workbooks.Open chemin & "\" & Nomfich
 
 
        Nomfich = Dir()
    Loop
    'Pour chaque sous-répertoire, appel récursif de Lister
    For Each Rep In fs.GetFolder(chemin).SubFolders
        NewRep = Lister(Rep.Path)
    Next Rep
End Function

[mercatog]

Bonjour,
1. Un lien pour l'explication: http://excel.developpez.com/faq/inde...riptingRuntime

2. Pour récupérer la valeur contenue dans A10 de la feuille Feuil1, tu n'as pas besoin de sélectionner cette cellule.

3. En plus, il fallait prévoir une sortie dès l'ouverture du 1er fichier

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub Appel()
Dim Chemin As String
 
Chemin = "C:\Users\user\Desktop"
OuvrirLeFichier Chemin, Sheets("Feuil1").Range("A10").Value
End Sub
 
Public Sub OuvrirLeFichier(ByVal Chemin As String, ByVal Lefichier As String)
Dim fs As Object, Rep As Object
Dim NomFich As String
Dim Existe As Boolean
 
If Lefichier <> "" Then
    NomFich = Dir(Chemin & "\*.xls")
    Do While NomFich <> ""
        If NomFich = Lefichier Then
            Workbooks.Open Chemin & "\" & NomFich
            Existe = True
            Exit Do
        End If
        NomFich = Dir()
    Loop
 
    If Not Existe Then
        Set fs = CreateObject("Scripting.FileSystemObject")
        For Each Rep In fs.GetFolder(Chemin).SubFolders
            OuvrirLeFichier Rep.Path, Lefichier
        Next Rep
        Set fs = Nothing
    End If
End If
End Sub

[Vadorblanc]

Bonjour mercatog
Je viens d'essayer la macro du lien proposé, et là ... le résultat dépasse mes espérances, fabuleux, je ne trouve pas les mots tellement c'est prodigieux...

J'ai essayé aussi ton code qui fonctionne aussi très bien, mais ne prends que

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

OuvrirLeFichier Chemin, Sheets("Feuil1").Range("A10").Value

la valeur en A10 et toujours cette cellule, je pensais que le code prendrais la valeur du 'focus' c'est à dire de la sélection de la cellule, si ma sélection est en A3 = recherche sur A3, si je me mets en A50 = recherche sur A50, je ne sais pas si c'est possible, mais ce serait juste pour le fun de savoir, car le code sur le lien sera ma façon de faire.
Je regarde si tu veux bien répondre, sinon, je marquerais Résolu.
Un grand merci à toi
Il faut que je lise tous ses liens, c'est fabuleux.
Bien cordialement

[mercatog]

Ceci recherchera le fichier de la cellule active

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

OuvrirLeFichier Chemin, activecell.Value

Néanmoins, tu peux toujours entrer en 2ème paramètre la cellule voulue

exemple en boucle

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub Appel()
Dim Chemin As String
Dim k as byte 
Chemin = "C:\Users\user\Desktop"
For k=3 to 10
   OuvrirLeFichier Chemin, Sheets("Liste").Range("A" & k).Value
Next k
End Sub

[Vadorblanc]

Mercatog
1er proposition sur la cellule A14 fonctionne
2è proposition sur la cellule active fonctionne
3è proposition sur le chemin ne fonctionne pas, toujours le 1er fichier qui s'ouvre, ou bien je n'ai pas tout compris, car la 2è proposition est bien la réponse à ma demande sur la cellule active.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub Appel() '3è proposition Appel sur le chemin ne fonctionne pas toujours le ! 1er fichier du répertoire qui s'ouvre
Dim Chemin As String
Dim k As Byte
    'Chemin = "C:\Users\user\Desktop"
Chemin = "C:\Essai"
For k = 3 To 10
   OuvrirLeFichier Chemin, Sheets(1).Range("A" & k).Value
 
Next k
End Sub
 
'.....................................................................
'Sub Appel() '2è proposition fonctionne Appel sur le focus de la cellule sélectionnée
'Dim Chemin As String
'Dim k As Byte
 
'Chemin = "C:\Essai"
'For k = 3 To 10
 
'OuvrirLeFichier Chemin, ActiveCell.Value  'prens en compte le focus de la cellule
'Next k
'End Sub
'....................................................................
 
'Sub Appel() ' 1er proposition fonctionne Appel de la cellule A14
'Dim Chemin As String
 
'Chemin = "C:\Essai"
 
'OuvrirLeFichier Chemin, Sheets(1).Range("A14").Value
'End Sub
'.......................................................................

Donc pour moi ce serait tout bon
Merci pour ta réponse

[mercatog]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub Appel() '3è proposition Appel sur le chemin ne fonctionne pas toujours le ! 1er fichier du répertoire qui s'ouvre
Dim Chemin As String
Dim k As Byte
    'Chemin = "C:\Users\user\Desktop"
Chemin = "C:\Essai"
For k = 3 To 10
   OuvrirLeFichier Chemin, Sheets(1).Range("A" & k).Value   
Next k
End Sub

ouvre successivement les fichiers dont les noms se trouvent dans les cellule de A3 à A10 de la première feuille (noms valides).

[patricktoulon]

bonjour

pour repondre a ta question c'est oui ca marche avec autant de sous dossiers que tu veux

et pour la variables representant le fichier repris dans la celule a10 rien de plus simple mais pour ca je pense que tu n'a pas bespoins de moi d'autant plus que mercatog t'en a donner les possibilités

au plaisir

apres relecture du post en entier on a oublié de traiter ton desir d'utiliser un touche pour faire ca
pour cela rien de plus simple regarde du coté de "application onkey" la macro sera appeler a partir de la


au plaisir

[Vadorblanc]

patricktoulon merci pour ta réponse

mercatog, ok ça marche j'ai compris.
Mais comme tu m'a proposé "un chemin" il m'est venu l'idée de me simplifier encore les choses, je reviens maintenant au code que tu m'a proposé sur le lien, dont il faut bien sûr écrire le chemin dans le code.
Comme je vais utiliser ce code sur d'autres postes à mon travail avec des chemins assez long et toujours fastidieux qui demande une grande application dans sa définition, et comme le mot impossible est à bannir de ce forum, je demande s'il serait possible qu'un premier code puisse laisser à l'utilisateur le choix du répertoire à sélectionner, puis d'enchainer sur le code du lien qui liste tous les fichiers de façon extraordinaire.
J'ai retrouvé un code que Qwazerty m'avait adapté et qui demandait en premier à l'utilisateur de choisir son répertoire, puis s'ensuivait l'exécution d'un autre code en boucle qui chargeait tous les fichiers les un après les autres avec des instructions demandées.
Seulement je n'arrive pas dissocier le code Appel du répertoire avec les instructions en boucle qu'il effectue pour les autres instructions.
Je souhaiterais que le code ne demande qu'à l'utilisateur de pointer sur le répertoire concerné, puis si ok par l'utilisateur, qu'il enchaine sur le code du lien et qu'il liste tous les fichiers du répertoire sélectionné.

Je joins ce code aussi fabuleux de Qwazerty, il est long et pour moi très complexe
Merci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
Option Explicit
Sub AppelRépertoire()
 ' Macro
'Declaration des variables
Dim Classeur_Maitre As Workbook, Classeur_Slave As Workbook
Dim oShell As Object, oFolder As Object
Dim oFolderItem As Object
Dim Tab_Files As Variant
Dim aFile As Variant
Dim ValueB7 As String 'si le contenu de la cellule B7 est numerique mettre Long ou integer a la place de string
Dim Cel As Range
 
 
Application.DisplayAlerts = False
 
Set Classeur_Maitre = ActiveWorkbook
 
'Moceau de code original pioché ici -> http://www.developpez.net/forums/d270516/autres-langages/general-visual-basic-6-vbscript/vbscript/vos-contributions-vbscript/faq-utiliser-boite-dialogue-selection-repertoire/
Set oShell = CreateObject("Shell.Application")
Set oFolder = oShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
If oFolder Is Nothing Then
    MsgBox "Abandon opérateur", vbCritical
    Exit Sub
Else
  Set oFolderItem = oFolder.Self
  'MsgBox oFolderItem.Path
End If
'Fin du morceau pioché
 
'On recupert les fichier contenu dans le repertoire en question
Tab_Files = ListFilesInFolder(oFolderItem.Path, False) 'mettre true a la place de false pour regarder les sous repertoires et rajouter une liste d'extension pour limiter les fichiers listés (,"txt;ert;doc;xls")
 
For Each aFile In Tab_Files
    Set Classeur_Slave = Workbooks.Open(aFile, ReadOnly:=True)
    'Ouvre le premier classeur et copie la cellule B7
    ValueB7 = Classeur_Slave.Sheets("En tête").Range("B7").Copy
    'Sélectionne la feuille toujours du premier classeur "Bordereau collecte"
    With Classeur_Slave.Sheets("Bordereau collecte")
        'Colle B7 en collage spécial valeurs si cellule adjacente non vide toujours du premier classeur
        For Each Cel In .Range(.Cells(4, "F"), .Cells(Rows.Count, "F").End(xlUp))
            If Cel <> "" Then Cel.Offset(0, -1).Value = ValueB7
        Next Cel
    End With
 
 
    'le tableau suivant est toujours de la meme taille ?"E4:AT1000" non d'un nombre de lignes différent mais jamais plus de 1000 je n'ai pas su rendre le code evolutif en fonction d'un nombre de ligne changeant !!
    Classeur_Slave.Sheets("Bordereau collecte").Range("E4:AT1000").Copy
  'Copie E4:AT100 du premier classeur et le colle en collage spécial valeurs dans le fichier de la macro Sheet "Tous les Bordereaux Collectes"
    With Classeur_Maitre.Sheets("Tous les Bordereaux Collectes").Range("A65536").End(xlUp)
        .Offset(2, 8).Value = Classeur_Slave.Name
        .Offset(2, 0).PasteSpecial Paste:=xlValues
    End With
 
    Classeur_Slave.Close False
Next
 
MsgBox "Attention, Tous les fichiers sont chargés, Enregistrer le fichier en ajoutant TOUS pour garder l'original vièrge"
 
 
End Sub
Function ListFilesInFolder(strFolderName As String, Optional bIncludeSubfolders As Boolean = False, Optional strTypeFichier As String) As Variant
  ' adapté de Ole P Erlandsen
  ' necessite d'activer la reference Microsoft Scripting RunTime par VBA Outils Références cocher Microsoft Scripting RunTime
 
  ' Code modifié par Qwazerty le 14/03/2010
  ' Code initial http://www.developpez.net/forums/d200523/logiciels/microsoft-office/excel/contribuez/lister-fichiers-repertoire-feuille-excel/
  ' En reponse a la demande de ce post http://www.developpez.net/forums/d891321/logiciels/microsoft-office/excel/macros-vba-excel/boucle-fichiers-repertoire/
  ' tabTypeFichier represente une liste des differents extensions a prendre en compte lors du dressage de la liste des fichiers, celle ci seront séparé par ; ex: "xls;doc"
  ' ListFilesInFolder renvoi un tableau contenant le chemin de chaque fichiers
 
  Static FSO As FileSystemObject
  Static bNotFirstTime As Boolean
  Static tabType As Variant, vType As Variant
  Static dicoType As Object
  Static strResult As String
  Dim bTheFirst As Boolean
  Dim oSourceFolder As Scripting.Folder
  Dim oSubFolder As Scripting.Folder
  Dim oFile As Scripting.File
  'Static wksDest As Worksheet
  'Static iRow As Long
 
  'initialisation
  bTheFirst = False
 
  If Not bNotFirstTime Then
    'On identifi le tout premiere appel de la fonction recursive
    bTheFirst = True
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set dicoType = CreateObject("Scripting.Dictionary")
    If strTypeFichier <> "" Then
        'On cré un tableau contenant toutes les extensions / * si rien de precisé
        tabType = Split(strTypeFichier, ";")
        ' a l'aide de ce tableau on renseigne notre dictionnaire
        For Each vType In tabType
            dicoType.Add vType, "Ext"
        Next
    End If
    bNotFirstTime = True
 
    On Error Resume Next
    Set oSourceFolder = FSO.GetFolder(strFolderName)
    On Error GoTo 0
 
    'On regarde si le rep existe bien
    If oSourceFolder Is Nothing Then
      MsgBox "Le répertoir '" & strFolderName & "' n'existe pas." & vbCrLf & "L'execution va prendre fin.", vbExclamation, "Répertoir inconnu"
      GoTo finApp
    End If
 
  End If
 
  Set oSourceFolder = FSO.GetFolder(strFolderName)
 
  'On boucle sur tous les fichier present
  For Each oFile In oSourceFolder.Files
    'On verifie que l'extension du fichier correspond a ce qui est demandé
    If dicoType.Exists(ExtractFileExt(oFile.Name)) Or (strTypeFichier = "") Then
        'On le rajoute dans la chaine result
        strResult = strResult & oFile.Path & ";"
    End If
  Next oFile
 
  'Si on a l'option Sous dossier on boucle sur les sous dossiers
  If bIncludeSubfolders Then
    For Each oSubFolder In oSourceFolder.SubFolders
    'On ajoute les fichiers contenu dans ce rep dans la liste precedente
      strResult = Join(ListFilesInFolder(oSubFolder.Path, True), ";") & ";"
    Next oSubFolder
  End If
 
  'On supprime le dernier ";" s'il il exist
  If Right(strResult, 1) = ";" Then strResult = Left(strResult, Len(strResult) - 1)
 
  'On renvoi le resulta sous forme de tabelau
  ListFilesInFolder = Split(strResult, ";")
 
finApp:
  'Si on se trouve dans le 1er appel on reinitialise les vaiables Static
  'pour ne pas conserver des valeurs static lors d'une prochaine utilisation de la fonction
  If bTheFirst Then
    Set FSO = Nothing
    Set dicoType = Nothing
    bNotFirstTime = False
    tabType = ""
    vType = ""
    strResult = ""
  End If
End Function
 
Function ExtractFileExt(strName As String) As String
    If InStr(strName, ".") = 0 Then
        ExtractFileExt = ""
    Else
        ExtractFileExt = Mid(strName, InStrRev(strName, ".") + 1)
    End If
End Function

qui doit enchainer sur le code du lienqui liste tous les fichiers

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
Option Explicit
 
Sub TestListeFichiers()
    Dim Dossier As String
 
    '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).
    'Dossier = "C:\Documents and Settings\mimi\dossier"
    'Dossier = "C:\Essai"
    Dossier = "C:"
 
    'Appelle la procédure de recherche des fichiers
    ListeFichiers Dossier
 
    'Ajuste la largeur des colonnes A:E en fonction du contenu des cellules.
    Columns("A:E").AutoFit
    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("A65536").End(xlUp).Row + 1
 
    'Boucle sur tous les fichiers du répertoire
    For Each FileItem In SourceFolder.Files
        'Inscrit le nom du fichier dans la cellule
        Cells(i, 1) = FileItem.Name
        'Ajoute un lien hypertexte vers le fichier
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), _
            Address:=FileItem.ParentFolder & "\" & FileItem.Name
        'Indique la date de création
        Cells(i, 2) = FileItem.DateCreated
        'Indique la date de dernier acces
        Cells(i, 3) = FileItem.DateLastAccessed
        'Indique la date de dernière modification
        Cells(i, 4) = FileItem.DateLastModified
        'Nom du répertoire
        Cells(i, 5) = FileItem.ParentFolder
 
        i = i + 1
    Next FileItem
 
 
    '--- 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

[patricktoulon]

bonjour je ne sai pas avec quel system d'exploitation tu travaille mais avec xp tu peux utiliser ma macro en metant simplement la letre du disk a la variable chemin
exemple
chemin="F:\"
donc la recherche va partir de la si tu bosse sur vista ou seven attend un peu je suis en train de chercher un solution avec babahote pour eviter les fichiers cachés et protégés


au plaisir

[Vadorblanc]

patricktoulon
As tu essayer de lancer la macro du lien qui liste tous les fichiers d'un répertoire, avec en plus les fichiers se mettent avec un lien hypertexte dont il suffit de cliquer dessus pour ouvrir directement le fichier recherché ... surprenant ... c'est vraiment ce que je cherchais depuis très longtemps, et même j'ai essayé sur mon disque C:, ça ne bloque pas, fichiers cachées ou pas, j'ai eu 3500 fichiers assez rapide, je clique sur n'importe lequel, excel word pdf ou autres, et il s'ouvre, sans plantage... je cherche juste maintenant à pointer directement sur un répertoire sans mettre dans le code le chemin pour que ce soit la cerise sur le gâteau, nous avons XP professionnel avec un administrateur qui limite nos droits, nos dossiers ont des chemins très long et de plus différents quand on navigue vers d'autres sites qui ont encore une arborecence différente, bon c'est réalisable même si personne ne réponds à mon post ...

[mercatog]

Pour laisser a l'utilisateur le choix du dossier "père" de recherche

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Appel()
Dim Repert As FileDialog
Dim Chemin As String
 
Set Repert = Application.FileDialog(msoFileDialogFolderPicker)
Repert.Show
 
If Repert.SelectedItems.Count > 0 Then
    Chemin = Repert.SelectedItems(1)
    Set Repert = Nothing
    OuvrirLeFichier Chemin, ActiveCell.value
End If
End Sub

[Vadorblanc]

Mercatog
je n'arrive pas mettre ton code
peux tu voir ce que j'ai fait
Merci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
Option Explicit
Sub Appel()
Dim Repert As FileDialog
Dim Chemin As String
 
Set Repert = Application.FileDialog(msoFileDialogFolderPicker)
Repert.Show
 
If Repert.SelectedItems.Count > 0 Then
    Chemin = Repert.SelectedItems(1)
    Set Repert = Nothing
    OuvrirLeFichier Chemin, ActiveCell.Value
End If
End Sub
 
 
Sub TestListeFichiers()
    Dim Dossier As String
 
    '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).
    'Dossier = "C:\Documents and Settings\mimi\dossier"
    'Dossier = "C:\Essai"
    Dossier = "C:"
 
    'Appelle la procédure de recherche des fichiers
    ListeFichiers Dossier
 
    'Ajuste la largeur des colonnes A:E en fonction du contenu des cellules.
    Columns("A:E").AutoFit
    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("A65536").End(xlUp).Row + 1
 
    'Boucle sur tous les fichiers du répertoire
    For Each FileItem In SourceFolder.Files
        'Inscrit le nom du fichier dans la cellule
        Cells(i, 1) = FileItem.Name
        'Ajoute un lien hypertexte vers le fichier
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), _
            Address:=FileItem.ParentFolder & "\" & FileItem.Name
        'Indique la date de création
        Cells(i, 2) = FileItem.DateCreated
        'Indique la date de dernier acces
        Cells(i, 3) = FileItem.DateLastAccessed
        'Indique la date de dernière modification
        Cells(i, 4) = FileItem.DateLastModified
        'Nom du répertoire
        Cells(i, 5) = FileItem.ParentFolder
 
        i = i + 1
    Next FileItem
 
 
    '--- 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