Liste de fichiers + Lire dans la liste

[Alex]

Bonjour,

Voila j'ai crée une fichier qui sert de 'template' à plusieurs utilisateurs ces derniers enregistrent ces fichiers dans le même répertoire selon une convention de nomage, je souhaite créer un fichier résumé qui :

1) récupère tous les nom de fichier du répertoire
2) extrait de ces fichiers dans la cellule à côté du nom une celule précise dans chaque fichier

ex:

monfichier.xls | =Excel.Sheet.8|'monfichier.xls'!'!SUMMARY!L12C8'

Donc 2 probs :
- 1 récupérer les noms de fichier
- constituer dynamiquement la formule avec pour variable 'monfichier.xls'

d'avance merci

 

[_Thierry]

Bonjour Alex, le Forum

Rapidos je pars déjeuner et j'ai faim !!!

Voici de quoi remonter tes Fichier sur la Feuille Active :

Option Explicit

Sub TheSearcher()
Dim ThisBookPath As String, TabFilePathName() As Variant
Dim FileSearcher As FileSearch
Dim ThePath As String
Dim i As Integer

Set FileSearcher = Application.FileSearch
ThisBookPath = ThisWorkbook.Path
ThePath = ThisBookPath

With FileSearcher
  .NewSearch
  .Filename = '*.xls*'
  .LookIn = ThePath
  .SearchSubFolders = True
  .Execute msoSortByFileName, msoSortOrderAscending
    If .Execute > 0 Then
        With .FoundFiles
            For i = 1 To .Count
            ReDim Preserve TabFilePathName(2, 0 To .Count - 1)
                TabFilePathName(0, i - 1) = .Item(i)
                TabFilePathName(1, i - 1) = Dir(.Item(i))
            Next i
        End With
    Else
        MsgBox 'Pas de Fichier trouvé dans ' & ThePath
        Exit Sub
    End If
End With
Set FileSearcher = Nothing

Range('A2').Resize(UBound(TabFilePathName, 2) + 1, UBound(TabFilePathName, 1)) = Application.Transpose(TabFilePathName)
End Sub

Pour le reste c'est juste une question de concaténation pour fabriquer une Formule, il y a eu encore des exemples dans la semaine dernière, car là je file...

Bon App
@+Thierry

 

[Alex]

Merci je vais regarder ça.

 

[Alex]

Ok impec la récup fonctionne à merveille ensuite j'essaye de créer ma formule

J'ai donc par exemple normalement comme formule dans la cellule d'à côté : ='C:\\test\\[M_LG_206125_C3310.xls]PURCHASING PLAN'!$C$72

J'arrive à reconstituer cette formul par concaténation mais je n'arrive pas à la lire. ci joint fichier exemple. [file name=Classeur1_20050725152730.zip size=8732]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Classeur1_20050725152730.zip[/file]

 

[tonio59]

bonjour,

Super cette macro ! ! ! ! Comme par bonheur, je cherchais la même chose pour un de mes fichiers, merci beaucoup.

Seulement, j'ai un ptit problème, je ne veux pas rechercher des fichiers .xls, mais des dossiers, je veux connaitre les dossiers qui existent dans le répertoire.

Si vous avez la soluce.

Merci d'avance

 

[_Thierry]

Bonjour Tonio, Re Bonjour Alex, le Forum

Tout d'abord Tonio, en général sur XLD on essaie de ne pas tout mélanger dans un même Fil, même si celà te semble 'cousin' la Propriété FileSearch n'a rien à voir avec une File System Object...

Donc pour Alex, voici le code qui fera ce que tu souhaite sans avoir besoin de faire des Formules tout est géré par VBA :

NB Attention toutefois si ta Feuille 'PURCHASING PLAN' n'existe pas...

Option Explicit

Const TheSheet As String = 'PURCHASING PLAN'
Const TheAddress As String = '$C$72'


Sub TheSearcher()
Dim ThisBookPath As String, TabFilePathName() As Variant
Dim FileSearcher As FileSearch
Dim ThePath As String
Dim i As Integer

Set FileSearcher = Application.FileSearch
ThisBookPath = ThisWorkbook.Path
ThePath = ThisBookPath

With FileSearcher
  .NewSearch
  .Filename = '*.xls*'
  .LookIn = ThePath
  .SearchSubFolders = True
  .Execute msoSortByFileName, msoSortOrderAscending
    If .Execute > 0 Then
        With .FoundFiles
            For i = 1 To .Count
            ReDim Preserve TabFilePathName(2, 0 To .Count - 1)
                TabFilePathName(0, i - 1) = .Item(i)
                TabFilePathName(1, i - 1) = Dir(.Item(i))
            Next i
        End With
    Else
        MsgBox 'Pas de Fichier trouvé dans ' & ThePath
        Exit Sub
    End If
End With
   
    Set FileSearcher = Nothing
    Range('A2').Resize(UBound(TabFilePathName, 2) + 1, UBound(TabFilePathName, 1)) = Application.Transpose(TabFilePathName)

TheFormulator
End Sub

Sub TheFormulator()
Dim Cell As Range
Dim TheFullPath As String
Dim ThePath As String
Dim TheFile As String
Dim TheFormula As String
    For Each Cell In Range('A2:A' & Range('A5000').End(xlUp).Row)
        TheFullPath = Cell.Text
        TheFile = Cell.Offset(0, 1).Text
        ThePath = Left(TheFullPath, Len(TheFullPath) - Len(TheFile))
        TheFormula = '='' & ThePath & '[' & TheFile & ']' & TheSheet & ''!' & TheAddress
        Cell.Offset(0, 2).Formula = TheFormula
    Next
End Sub

Je pense qu'on sera bon ce coup si...

Pour notre ami Tonio qui semble nouveau sur XLD, donc voici le code qu'il te faut :

Sub TheDirSearcher()
Dim FSO As Object, ObjDirectory As Object, ObjFolder As Object
Dim TheDirectory As String
Dim i As Integer

TheDirectory = InputBox('Nom du répertoire (niveau de départ)', 'NOM DU REPERTOIRE', 'UserName\\My Documents')
TheDirectory = 'C:\\Documents and Settings\\' & TheDirectory

Set FSO = CreateObject('Scripting.FileSystemObject')
On Error GoTo Out
Set ObjDirectory = FSO.GetFolder(TheDirectory)

        For Each ObjFolder In ObjDirectory.SubFolders
            i = i + 1
            Range('A' & i).Value = ObjFolder.Name
        Next

Set FSO = Nothing
Set ObjDirectory = Nothing
Exit Sub
Out:
If Err = 76 Then MsgBox 'Répertoire Non Trouvé ' & TheDirectory
Set FSO = Nothing
End Sub

Ce code listera les réperoire du niveau du répertoire que tu spécifieras...

Bon Aprèm
@+Thierry

 

[_Thierry]

Et dans la foulée des Répertoires pour Tonio

J'avais dans mes archives aussi cet excellent code de Frédiquer Sigonneau :

Sub Test()
    TousLesDossiers 'C:\\Documents and Settings\\', 0
End Sub

Sub TousLesDossiers(LeDossier$, Idx As Long)
Dim fso As Object, Dossier As Object
Dim sousRep As Object, Flder As Object

Set fso = CreateObject('Scripting.FileSystemObject')
Set Dossier = fso.GetFolder(LeDossier)

'examen du dossier courant
For Each Flder In Dossier.SubFolders
Idx = Idx + 1
Cells(Idx, 1).Value = Flder.Path
Next

'traitement récursif des sous dossiers
For Each sousRep In Dossier.SubFolders
TousLesDossiers sousRep.Path, Idx
Next sousRep
Set fso = Nothing

End Sub 'fs <= Frederique Sigonneau

NB ne pas evoyer directement sous 'C:\\' ... ce code listera Tous les Répertoires et tous les Sous Répertoires... Lasting OverNight Long !!! LOL

Bonne Fin de Journée
@+Thierry

 

[CyK]

Merci bcp (c'est alex me suis créé un compte),

J'ai repris le code modifié 2 3 truc en m'insiprant de ce que tu as fais tout marche impéc

 

[Nashou]

Super génial cette macro qui récup les fichiers d'un dossier.

Par contre, est-il possible qu'à chaque fois que l'on execute cette macro, la nouvelle récuperation des noms des fichiers efface l'ancienne récupération ?

J'ai testé cette macro en enlevant des fichiers.
Par exemple, j'ai récupérer 5 fichiers et le coup d'apres je dois en récupérer 3.
La macro me récupère bien les 3 nouveaux mais me laisse les 2 anciens !!
Une idée ?

 

[tonio59]

bonjour à tous,

Tout d'abord désolé Thierry, je pensais qu'il fallait seulement modifier l'extension recherchée pour trouver tous les dossiers. Merci du code, il fonctionne à merveille . . .

La prochaine fois j'essaerai de créer un nouveau post pour une demande.

Merci encore, Ciao.