[VBA]Indexer Répertoire selon Arborescence

[TheLio]

Bonjour le forum,
Me voilà avec un nouveau challenge pour nos éminences-vébéistes :

Voici l’énoncé de l’objectif Idéal à atteindre :

Il s’agit d’une démarche qualité et de sa gestion documentaire,
Les différents documents aux formats word et excel sont classés dans des dossiers et sous dossiers (sur 3 niveaux) adoptant une codification assez claire en chiffres et lettres suivie du Titre du document

L’idée serait de créer une table des matières respectant cette arborescence, incluant les dossiers, sous dossiers, et documents le tout affublé de liens hypertextes permettant l’ouverture aussi bien de dossiers que de docs word et excel.

Cette demande est faite car l’évolution du système qualité est en constante modification et que la gestion de la table des matières prend plus de temps que la création de dossiers.

D’avance merci pour vos études et propositions et excellentes journées

TheLio

 

[Staple1600]

Re : [VBA]Indexer Répertoire selon Arborescence

Bonjour à tous


Je te conseille la lecture de ce post:
https://www.excel-downloads.com/threads/lien-hypertexte-vers-onglets-de-classeurs-fermes.58470/

edit:
En faisant une recherche sur le forum avec les mots-clés
lister répertoires
tu trouveras d'autres exemples


un début de piste avec ce code

Sub test()
'adaptée de:
'http://www.developpez.net/forums/showthread.php?t=342976
Dim Chemin As String
Dim i As Integer
Dim objFSO As Object, objFile As Object
Chemin = "C:\Temp"
Set objFSO = CreateObject("Scripting.FileSystemObject")

Application.ScreenUpdating = False
With Application.FileSearch
    .NewSearch
    .FileType = msoFileTypeOfficeFiles
    .LookIn = Chemin
    .SearchSubFolders = True
    .Execute
    Cells(1, 1).Value = "N°"
    Cells(1, 2).Value = "Nom Dossier"
    Cells(1, 3).Value = "Nom fichier"
    Range("A1:C1").Font.Bold = True
    With .FoundFiles
        For i = 1 To .Count
            Cells(i + 1, 1) = i
            Worksheets(1).Hyperlinks.Add Cells(i + 1, 3), .Item(i)
            Cells(i + 1, 3).Hyperlinks(1).TextToDisplay = Dir(.Item(i))
        
            Set objFile = objFSO.GetFile(.Item(i))
            Cells(i + 1, 2) = Dir(objFSO.GetParentFolderName(objFile), vbDirectory)
        
        Next i
    End With
End With
 
Columns("C:E").AutoFit

Application.ScreenUpdating = False
End Sub

 

[TheLio]

Re : [VBA]Indexer Répertoire selon Arborescence

Hello,
C'est tout bonnement "Parfait"
Je n'avais pas étendu mes recherches assez Loin
Merci
A++
TheLio