Discussion :

[Alex BI]

Hello les chauds du VBA,

J'ai beau essayer de faire avec les infos disponibles sur le FAQ Excel https://excel.developpez.com/faq/?page=FichiersDir je n'y arrive pas.

Ce que cherche à faire c'est :

-A partir d'une liste de référence en string sur excel (2000 environ)

-Rechercher si cette string existe comme une partie d'un nom de document dans le dossier X et tous les sous-dossiers.

-Résultat : lister les adresses des documents en face des références

Exemple : Une des 2000 références est "ETFS3", je voudrais scanner tous les dossiers (et sous-dossiers) du répertoire X et écrire dans la liste en face de "ETFS3" son adresse genre "C:\X\sousdossier3\ALLOCATED ETFS3 ITEMS.doc"

Donc en gros retrouver ou sont des documents à partir d'une partie de leur nom.

Merci d'avance à ceux qui pourront me donner des pistes.

Alex

[EricDgn]

Bonjour,

Le code trouvé suivant, trouvé sur le net, devrait être facile à adapter:

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
Option Explicit
 
'--- Nécessite d'activer la référence "Microsoft Scripting RunTime"
 
Sub Liste_fichiers_deDossier_et_deSousDossier()
    Dim Dossier As String
    Dossier = "D:\Tests"          'à adapter
    ListeFichiers Dossier
End Sub
 
Sub ListeFichiers(Repertoire As String)
    'Nécessite d'activer la référence "Microsoft Scripting RunTime"
    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)
 
    i = Cells(Rows.Count, 1).End(xlUp).Row + 1      '--- première ligne vide dans colonne 1 = A
 
    For Each FileItem In SourceFolder.Files
        Cells(i, 1) = FileItem.path                 '--- pour premiers tests
        '--- vérification sur le nom
        'If InStr(FileItem.Name, TexteCherché) > 0 Then
            '--- code texte trouvé
            'Cells(i, 1) = FileItem.path             '--- dossier + nom
            'Cells(i, 1) = FileItem.ParentFolder     '--- dossier
            'Cells(i, 2) = FileItem.Name             '--- nom
            'Cells(i, 3) = FileItem.DateCreated
            'Cells(i, 4) = FileItem.DateLastAccessed
            'Cells(i, 5) = FileItem.DateLastModified
            i = i + 1
        'End If
    Next FileItem
 
    For Each SubFolder In SourceFolder.SubFolders
        ListeFichiers SubFolder.path
    Next SubFolder
 
End Sub

Cordialement.