XL 2021 Liste des propriétés de fichiers.

jeff1494

jeff1494

XLDnaute Occasionnel
Bonjour à toutes et tous;
Encore une fois je retourne vers la communauté car je suis sûr qu'une âme charitable pourra m'aider;
Voilà mon problème :
J'ai récupéré, grâce à un utilitaire, sous forme d'un fichier Excel tout le contenu d'un dossier contenant un paquet de sous-dossier et de fichiers.
Le but est de pouvoir à terme faire le ménage et de classer tout ce bazar d'une manière facilement compréhensible.
Cette partie là se fera manuellement pour l'instant.
Je récupère des informations du genre le nom, le chemin, la taille, ... de chaque fichier.
Ce qui représente les colonnes suivantes :
  1. Nom du fichier
  2. Extension du fichier
  3. Date de création
  4. Taille du fichier
  5. Répertoire où se trouve le fichier
  6. Date de modification du fichier
  7. Heure de modification du fichier
  8. Chemin d'accès au fichier.
Comme tout cela vient d'un outil externe si je veux changer des infos cela sera fait lors de la création du fichier Excel par cet outil.
Par contre sur pas mal de fichier j'ai ajouté des commentaires. Et ce sont ces derniers que j'aimerais pouvoir lister.

Existe-t-il une liste permettant d'identifier toutes les données attachées au fichier, celles que l'on peut modifier via l'écran des propriétés du fichier.
Je parle de cet écran :

Exemple.jpg

D'avance je remercie celles et ceux qui prendront le temps de se pencher sur ma demande.
Bonne journée à toutes et tous.
 
Trier par date Trier par votes
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
avec une collection en recursif avec mise en evidence des ligne de dossier
VB: 
'*****************************************************************************************************
'    ___     _     _______  __      _   ____  _   _  _______  ___     _   _   _    ___     _     _.
'   //  \\  /\\      //    // \\   //  //    //  //    //    //  \\  //  //  //   //  \\  //|   //
'  //___// //__\    //    //__//  //  //    //__//    //    //   // //  //  //   //   // // |  //
' //      //   \\  //    //  \\  //  //    //  \\    //    //   // //  //  //   //   // //  | //
'//      //    // //    //   // //  //___ //    \\  //     \\__// //__//  //___ \\__// //   |//
'****************************************************************************************************
'collection sub  et fonction avec récursivité
'liste recursive d'un dossier avec lecture des propriétés
'date 18/08/2024
'librairie utilise shell Automation( en late binding)
'auteur :patricktoulon
'version :3
Option Explicit
Sub test()
    Dim chemin, table(1 To 100000, 1 To 150), cel
    chemin = "K:\vba excel\01 HTML XML CDO OUTLOOK requete html"
    ListeProprietesFichiers_getDetailsOf chemin, table
    Cells.Clear
    Application.ScreenUpdating = False
    With Feuil1.[a1].Resize(UBound(table), 50)
        .Value = table
        Columns.AutoFit
        .VerticalAlignment = xlCenter
        'je met les dossiers en évidence
        For Each cel In .Columns(1).Cells
            If cel.Text Like "DOSSIER:*" Then cel.Font.Color = vbRed
        Next
    End With
End Sub

Sub ListeProprietesFichiers_getDetailsOf(folder, ByRef table, Optional a As Long = 1)

    Dim strFileName As Object, objFolder As Object, i As Byte, e, ProP$
    Dim collect As New Collection
    Static objShell As Object
    If a = 1 Then
        Set objShell = CreateObject("Shell.Application")
        table(2, 1) = "DOSSIER: " & folder
        a = a + 1
    End If
    Set objFolder = objShell.Namespace(folder) 'Répertoire à traiter
    For Each strFileName In objFolder.Items 'boucle sur tous les elements du repertoire
        'Pour que les dosssiers ne soient pas pris en comptes
        If strFileName.IsFolder = False Then
            e = 0
            a = a + 1
            For i = 0 To 250
                Select Case objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Nom": table(a, 1) = objFolder.getDetailsOf(strFileName, i): table(1, 1) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Taille": table(a, 2) = objFolder.getDetailsOf(strFileName, i): table(1, 2) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Extension du fichier": table(a, 3) = objFolder.getDetailsOf(strFileName, i): table(1, 3) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Commentaires": table(a, 4) = objFolder.getDetailsOf(strFileName, i): table(1, 4) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Modifié le": table(a, 5) = objFolder.getDetailsOf(strFileName, i): table(1, 5) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Date de création": table(a, 6) = objFolder.getDetailsOf(strFileName, i): table(1, 6) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Date d’accès": table(a, 7) = objFolder.getDetailsOf(strFileName, i): table(1, 7) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Sorte": table(a, 8) = objFolder.getDetailsOf(strFileName, i): table(1, 8) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Notation": table(a, 9) = objFolder.getDetailsOf(strFileName, i): table(1, 9) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Auteurs": table(a, 10) = objFolder.getDetailsOf(strFileName, i): table(1, 10) = objFolder.getDetailsOf(objFolder.Items, i)
                        'Case "Chemin du dossier": table(a, 11) = objFolder.getDetailsOf(strFileName, i): table(1, 10) = objFolder.getDetailsOf(objFolder.Items, i)
                End Select
            Next
            table(1, 11) = "path": table(a, 11) = strFileName.Path
        Else
            'si c 'est un dossier on collectionne le dossier <<<<!!!dans la collection de l'instance de la sub!!!>>>>
            collect.Add strFileName.Path

        End If
    Next
    Dim subfolder
    'on relance la sub avec les chemin de dossoier de la collection
    For Each subfolder In collect
        a = a + 1
        table(a, 1) = "DOSSIER: " & subfolder
        ListeProprietesFichiers_getDetailsOf (subfolder), table, a
    Next
End Sub
 
Vote positif 0 Vote négatif
jeff1494

jeff1494

XLDnaute Occasionnel
Bonsoir @patricktoulon ;

Merci pour ces codes, maintenant il faut que je comprenne mes erreurs, et surtout comment tu as procédé.
J'ai ouvert une conversation pour toi où je t'explique un peu plus en détails les pourquoi du comment j'en suis arrivé à ce point.

Je regarde tes codes après diner.
Encore merci et A+.
 
Vote positif 0 Vote négatif
jeff1494

jeff1494

XLDnaute Occasionnel
Je n'ai pas pu attendre après dîner, alors j'ai essayé tes deux codes, et finalement celui que je préfère est le deuxième.
Je n'arrive pas à joindre mon fichier au format ZIP, chargé depuis un petit répertoire de test créé pour l'occasion.
"Fichier trop volumineux", donc si tu en as besoin je passerais par un site de téléchargement..
Dis moi si tu en as besoin.
En attendant voici une image du résultat.

Fichier_résultat_P-Toulon.jpg


Je te tiendrais au courant.
Voici le code que j'ai utilisé, ayant ajouté la sélection du dossier, et renommé la sub "test" en "LstCommFich" .

VB: 
'*****************************************************************************************************
'    ___     _     _______  __      _   ____  _   _  _______  ___     _   _   _    ___     _     _.
'   //  \\  /\\      //    // \\   //  //    //  //    //    //  \\  //  //  //   //  \\  //|   //
'  //___// //__\    //    //__//  //  //    //__//    //    //   // //  //  //   //   // // |  //
' //      //   \\  //    //  \\  //  //    //  \\    //    //   // //  //  //   //   // //  | //
'//      //    // //    //   // //  //___ //    \\  //     \\__// //__//  //___ \\__// //   |//
'****************************************************************************************************
'collection sub  et fonction avec récursivité
'liste recursive d'un dossier avec lecture des propriétés
'date 18/08/2024
'librairie utilise shell Automation( en late binding)
'auteur :patricktoulon
'version :3
'
'__________________________________________________________________________________________
'
'             Avec une collection en récursif avec mise en évidence des ligne de dossier
'             Correspond à ton deuxième code du message N° 31
'__________________________________________________________________________________________
Option Explicit
Sub LstCommFich()
    Dim chemin, table(1 To 100000, 1 To 150), cel
        
    ' *** DEBUT ******** Ajout JFC pour sélection du dossier à traiter  ******************
        Dim Dossier As FileDialog
        Set Dossier = Application.FileDialog(msoFileDialogFolderPicker)
        If Dossier.Show <> -1 Then Exit Sub
        chemin = Dossier.SelectedItems(1)
        'chemin = "K:\vba excel\01 HTML XML CDO OUTLOOK requete html"
    ' *** FIN ******** Ajout JFC pour sélection du dossier à traiter  ********************

    ListeProprietesFichiers_getDetailsOf chemin, table
    Cells.Clear
    Application.ScreenUpdating = False
    With Feuil1.[a1].Resize(UBound(table), 50)
        .Value = table
        Columns.AutoFit
        .VerticalAlignment = xlCenter
        'je met les dossiers en évidence
        For Each cel In .Columns(1).Cells
            If cel.Text Like "DOSSIER:*" Then cel.Font.Color = vbRed
        Next
    End With
End Sub

Sub ListeProprietesFichiers_getDetailsOf(folder, ByRef table, Optional a As Long = 1)

    Dim strFileName As Object, objFolder As Object, i As Byte, e, ProP$
    Dim collect As New Collection
    Static objShell As Object
    If a = 1 Then
        Set objShell = CreateObject("Shell.Application")
        table(2, 1) = "DOSSIER: " & folder
        a = a + 1
    End If
    Set objFolder = objShell.Namespace(folder) 'Répertoire à traiter
    For Each strFileName In objFolder.Items 'boucle sur tous les elements du repertoire
        'Pour que les dosssiers ne soient pas pris en comptes
        If strFileName.IsFolder = False Then
            e = 0
            a = a + 1
            For i = 0 To 250
                Select Case objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Nom": table(a, 1) = objFolder.getDetailsOf(strFileName, i): table(1, 1) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Taille": table(a, 2) = objFolder.getDetailsOf(strFileName, i): table(1, 2) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Extension du fichier": table(a, 3) = objFolder.getDetailsOf(strFileName, i): table(1, 3) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Commentaires": table(a, 4) = objFolder.getDetailsOf(strFileName, i): table(1, 4) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Modifié le": table(a, 5) = objFolder.getDetailsOf(strFileName, i): table(1, 5) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Date de création": table(a, 6) = objFolder.getDetailsOf(strFileName, i): table(1, 6) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Date d’accès": table(a, 7) = objFolder.getDetailsOf(strFileName, i): table(1, 7) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Sorte": table(a, 8) = objFolder.getDetailsOf(strFileName, i): table(1, 8) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Notation": table(a, 9) = objFolder.getDetailsOf(strFileName, i): table(1, 9) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Auteurs": table(a, 10) = objFolder.getDetailsOf(strFileName, i): table(1, 10) = objFolder.getDetailsOf(objFolder.Items, i)
                        'Case "Chemin du dossier": table(a, 11) = objFolder.getDetailsOf(strFileName, i): table(1, 10) = objFolder.getDetailsOf(objFolder.Items, i)
                End Select
            Next
            table(1, 11) = "path": table(a, 11) = strFileName.Path
        Else
            'si c 'est un dossier on collectionne le dossier <<<<!!!dans la collection de l'instance de la sub!!!>>>>
            collect.Add strFileName.Path

        End If
    Next
    Dim subfolder
    'on relance la sub avec les chemin de dossoier de la collection
    For Each subfolder In collect
        a = a + 1
        table(a, 1) = "DOSSIER: " & subfolder
        ListeProprietesFichiers_getDetailsOf (subfolder), table, a
    Next
End Sub

Tu verras que j'ai essayé de mettre plusieurs types de fichiers.
Des détails comme les fichiers contenus dans un ZIP, on ne reprend pas les commentaires des fichiers du ZIP.
Je suppose que cela n'est pas possible.
C'est pas grave du tout. ?
Je pense passer la liste sous forme de tableau structuré une fois le résultat obtenu.
J'ai cru comprendre dans un de tes posts ou tu travaillais avec les fichiers ZIP qu'ils n'étaient pas si faciles que cela a appréhender.

Encore merci et bonne soirée à toi.
Je vais aller préparer le dîner.
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
comme tu peux le voir ici le dossier examiné est un fichier zip que j'examine avec le même code comme si c'etait un dossier
et il est parfaitement listé et les propriétés (si disponibles sont listées avec )
VB: 
'*****************************************************************************************************
'    ___     _     _______  __      _   ____  _   _  _______  ___     _   _   _    ___     _     _.
'   //  \\  /\\      //    // \\   //  //    //  //    //    //  \\  //  //  //   //  \\  //|   //
'  //___// //__\    //    //__//  //  //    //__//    //    //   // //  //  //   //   // // |  //
' //      //   \\  //    //  \\  //  //    //  \\    //    //   // //  //  //   //   // //  | //
'//      //    // //    //   // //  //___ //    \\  //     \\__// //__//  //___ \\__// //   |//
'****************************************************************************************************
'collection sub  et fonction avec récursivité
'liste recursive d'un dossier avec lecture des propriétés
'date 18/08/2024
'librairie utilise shell Automation( en late binding)
'auteur :patricktoulon
'version :3
Option Explicit
Sub test()
    Dim chemin, table(1 To 100000, 1 To 150), cel
    chemin = "C:\Users\patricktoulon\Desktop\CreatorRibbonX V4.9 et V5.0\Nouveau dossier\z_exemple backstage\Add Custom Tab to Backstage View.zip"
    ListeProprietesFichiers_getDetailsOf chemin, table
    Cells.Clear
    Application.ScreenUpdating = False
    With Feuil1.[a1].Resize(UBound(table), 50)
        .Value = table
        Columns.AutoFit
        .VerticalAlignment = xlCenter
        'je met les dossiers en évidence
        For Each cel In .Columns(1).Cells
            If cel.Text Like "DOSSIER:*" Then cel.Font.Color = vbRed
        Next
    End With
End Sub

Sub ListeProprietesFichiers_getDetailsOf(folder, ByRef table, Optional a As Long = 1)

    Dim strFileName As Object, objFolder As Object, i As Byte, e, ProP$
    Dim collect As New Collection
    Static objShell As Object
    If a = 1 Then
        Set objShell = CreateObject("Shell.Application")
        table(2, 1) = "DOSSIER: " & folder
        a = a + 1
    End If
    Set objFolder = objShell.Namespace(folder) 'Répertoire à traiter
    For Each strFileName In objFolder.Items 'boucle sur tous les elements du repertoire
        'Pour que les dosssiers ne soient pas pris en comptes
        If strFileName.IsFolder = False Then
            e = 0
            a = a + 1
            For i = 0 To 250
                Select Case objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Nom": table(a, 1) = objFolder.getDetailsOf(strFileName, i): table(1, 1) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Taille": table(a, 2) = objFolder.getDetailsOf(strFileName, i): table(1, 2) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Extension du fichier": table(a, 3) = objFolder.getDetailsOf(strFileName, i): table(1, 3) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Commentaires": table(a, 4) = objFolder.getDetailsOf(strFileName, i): table(1, 4) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Modifié le": table(a, 5) = objFolder.getDetailsOf(strFileName, i): table(1, 5) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Date de création": table(a, 6) = objFolder.getDetailsOf(strFileName, i): table(1, 6) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Date d’accès": table(a, 7) = objFolder.getDetailsOf(strFileName, i): table(1, 7) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Sorte": table(a, 8) = objFolder.getDetailsOf(strFileName, i): table(1, 8) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Notation": table(a, 9) = objFolder.getDetailsOf(strFileName, i): table(1, 9) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Auteurs": table(a, 10) = objFolder.getDetailsOf(strFileName, i): table(1, 10) = objFolder.getDetailsOf(objFolder.Items, i)
                        'Case "Chemin du dossier": table(a, 11) = objFolder.getDetailsOf(strFileName, i): table(1, 10) = objFolder.getDetailsOf(objFolder.Items, i)
                End Select
            Next
            table(1, 11) = "path": table(a, 11) = strFileName.Path
        Else
            'si c 'est un dossier on collectionne le dossier <<<<!!!dans la collection de l'instance de la sub!!!>>>>
            collect.Add strFileName.Path

        End If
    Next
    Dim subfolder
    'on relance la sub avec les chemin de dossoier de la collection
    For Each subfolder In collect
        a = a + 1
        table(a, 1) = "DOSSIER: " & subfolder
        ListeProprietesFichiers_getDetailsOf (subfolder), table, a
    Next
End Sub
elle sont magiques les fonction Ptoulon :D ;)
 
Vote positif 0 Vote négatif
jeff1494

jeff1494

XLDnaute Occasionnel
@kiki29 :
Bonjour et merci pour le lien. En fait je n'ai pas pensé aller voir ce que Mr Boisgontier avait fait sur le sujet. Grosse erreur de ma part.
Par contre en parcourant la page j'ai trouvé un bout de code qui va bien m'aller, à savoir la taille du dossier, qui me manque pour l'instant. Voir comment l'intégrer dans le code de PatrickToulon.

@patricktoulon :
Bonjour, je suis en train d'essayer de comprendre ton code, et je pense devoir revenir vers toi pour quelques explications. Je n'ai pas l'habitude de travailler avec des tableaux, or c'est une grosse partie de ton code (du moins pour ce que j'en ai vu pour l'instant).
Je vais aussi essayer d'intégrer le code de Mr Boisgontier pour la taille du répertoire (Info que l'on a pas nativement avec l'explorateur de Windows, mais qui est intéressante.)
En attendant de revenir ici pour poser mes questions, je vous souhaite à tous les deux une bonne journée.
A+.
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
Bonjour
plus rapide , moins lourd et l"a t"aille des dossier en "Ko"
le tableau est incrémenté au fur et a mesure
et retransposé à la fin
VB: 
Sub test()
    Dim chemin, table(), cel, rowCount As Long
    chemin = "K:\vba excel\01 HTML XML CDO OUTLOOK requete html"
     ListeProprietesFichiers_getDetailsOf chemin, table
 
    Cells.Clear
    'Application.ScreenUpdating = False
    With Feuil1.[a1].Resize(UBound(table, 2), 11) ' Redimensionnement dynamique
        .Value = Application.Transpose(table)
        Columns.AutoFit
        .VerticalAlignment = xlCenter
        For Each cel In .Columns(1).Cells
            If cel.Text Like "DOSSIER:*" Then cel.Font.Color = vbRed
        Next
    End With
End Sub

Function ListeProprietesFichiers_getDetailsOf(folder, ByRef table, Optional a As Long = 1)
    Dim strFileName As Object, objFolder As Object, i As Byte, e As Integer, ProP$
    Dim collect As New Collection
    Static objShell As Object: Static FsO As Object
    
    If a = 1 Then
        a = a + 1
        Set objShell = CreateObject("Shell.Application")
        Set FsO = CreateObject("Scripting.FileSystemObject")
        ReDim table(1 To 11, 1 To a) ' Table redimensionné
        table(1, a) = "DOSSIER: " & folder
        table(2, a) = FsO.getfolder(folder).Size / 1000 & " Ko"
    End If

    Set objFolder = objShell.Namespace(folder)
    
    For Each strFileName In objFolder.Items
        If Not strFileName.IsFolder Then
            a = a + 1
             ReDim Preserve table(1 To 11, 1 To a) ' Ajustement dynamique du tableau
             For i = 0 To 250
                Select Case objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Nom": table(1, a) = objFolder.getDetailsOf(strFileName, i): table(1, 1) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Taille": table(2, a) = objFolder.getDetailsOf(strFileName, i): table(2, 1) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Extension du fichier": table(3, a) = objFolder.getDetailsOf(strFileName, i): table(3, 1) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Commentaires": table(4, a) = objFolder.getDetailsOf(strFileName, i): table(4, 1) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Modifié le": table(5, a) = objFolder.getDetailsOf(strFileName, i): table(5, 1) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Date de création": table(6, a) = objFolder.getDetailsOf(strFileName, i): table(6, 1) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Date d’accès": table(7, a) = objFolder.getDetailsOf(strFileName, i): table(7, 1) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Sorte": table(8, a) = objFolder.getDetailsOf(strFileName, i): table(8, 1) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Notation": table(9, a) = objFolder.getDetailsOf(strFileName, i): table(9, 1) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Auteurs": table(10, a) = objFolder.getDetailsOf(strFileName, i): table(10, 1) = objFolder.getDetailsOf(objFolder.Items, i)
                        'Case "Chemin du dossier": table(a, 11) = objFolder.getDetailsOf(strFileName, i): table(1, 10) = objFolder.getDetailsOf(objFolder.Items, i)
                End Select
            Next
            'table(1, 11) = "path": table(a, 11) = strFileName.Path
            
            
            ' Ajoute d'autres colonnes selon les besoins
            table(11, a) = strFileName.Path
        Else
            collect.Add strFileName.Path
        End If
    Next
    
    Dim subfolder
    For Each subfolder In collect
        a = a + 1
         ReDim Preserve table(1 To 11, 1 To a)
        table(1, a) = "DOSSIER: " & subfolder
        table(2, a) = FsO.getfolder(subfolder).Size / 1000 & " Ko"
         ListeProprietesFichiers_getDetailsOf subfolder, table, a
    Next

    ListeProprietesFichiers_getDetailsOf = table ' Retourne le nombre de lignes utilisées
End Function
 
Vote positif 0 Vote négatif
jeff1494

jeff1494

XLDnaute Occasionnel
Bojour ;
@patricktoulon :

Je viens de tester ton code qui, est beaucoup plus rapide que les précédents, et qui marche très bien si je n'ai pas de fichier ZIP dans le répertoire.
En ajoutant juste un fichier ZIP dans le dossier parcouru alors cela plante.
Je bloque sur l'instruction suivante :

Chemin introuvable.jpg


Ligne erreur.jpg


Encore merci beaucoup pour ton aide. Il va juste falloir que je puisse assimiler des concepts que tu utilises et que je ne connais absolument pas telle que les collections.
Je me trouve face à ce qui pour moi est une montagne à gravir. Alors cela prendra certainement un peu (beaucoup ? 🥵) de temps, mais je ne vois pas (encore 🫣 ) de raisons pour ne pas y arriver.
Merci à toi et bonne soirée.
 
Vote positif 0 Vote négatif
jeff1494

jeff1494

XLDnaute Occasionnel
@patricktoulon :
Bien j'essaie de progresser avec le code que tu m'as donné. Ce que j'ai réalisé :
  • Ajout de la sélection du répertoire à traiter
  • Mise en place des liens vers les fichiers et répertoires.
Sur le second point cela bloque encore un peu. J'arrive à ouvrir les fichiers, mais je n'arrive pas encore à ouvrir l'explorateur sur le dossier.
Je dois juste regarder de plus près.
J'ai ajouté une feuille pour mettre en place (temporairement ou pas ?) le lancement des macros.

Je vais essayer me voir si j'arrive à attaquer les mots clés des fichiers. J'ai vu qu'il était possible de le faire avec la référence à DSO File, mais que ce n'était pas possible sur un système x64. Or sur ce forum j'ai peut-être trouvé la solution.

Use DSO File on x64

Je dois regarder comment cela serait possible. Si cela fonctionne je devrais ajouter une colonne avec les mots clés.
Le Nec plus Ultra serait à terme de pouvoir faire des recherches sur les commentaires ainsi que sur les mots-clé.
mais là je m'emballe un peu trop vu mon niveau. Mais c'est un énorme challenge, et cela me motive.

Sur ce bonne soirée à toi.
 

Pièces jointes

  • Version PatrickToulon-Taille répertoire.xlsm
    38 KB · Affichages: 3
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
bonjour @jeff1494
a moins que DSO te propose plus de propriété ,je ne vois pas pourquoi aller chercher une librairie externe
les liens vers les fichier y sont déja me semble t il
le liens vers les dossiers peuvent être ajouté de la même manière que les fichiers
ouvrir l'explorateur sur un dossier précis il y a chdrive et chdir pour ca
pour créer un moteur de recherche par rapport aux commentaire de fichier rien de plus simple
on reprend mon moteur tel que je te l'ai donné avec une condition sur le commentaire
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
une version avec les liens cliquables en colonne 11
mise en évidence des dossiers un peu plus poussée
VB: 
Sub test()
    Dim chemin, table(), cel As Range, rowCount As Long
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
            chemin = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With

    ListeProprietesFichiers_getDetailsOf chemin, table

    Cells.Clear
    Application.ScreenUpdating = False
    With Feuil1.[a1].Resize(UBound(table, 2), 11) ' Redimensionnement dynamique
        .Value = Application.Transpose(table)
        .VerticalAlignment = xlCenter
        For Each cel In .Columns(1).Cells
            If cel.Text Like "DOSSIER:*" Then
                cel.Font.Color = vbRed
                cel.Font.Bold = True
                ActiveSheet.Hyperlinks.Add Anchor:=cel.Offset(, 10), Address:=cel.Offset(, 10).Text, TextToDisplay:="DOSSIER : " & cel.Offset(, 10).Text
                With cel.Resize(, 11)
                    .Font.Bold = True
                    .Font.Size = 13
                End With
            Else
                ActiveSheet.Hyperlinks.Add Anchor:=cel.Offset(, 10), Address:=cel.Offset(, 10).Text, TextToDisplay:=cel.Offset(, 10).Text
            End If
        Next
        Columns.AutoFit
    End With
End Sub

Function ListeProprietesFichiers_getDetailsOf(folder, ByRef table, Optional a As Long = 1)
    Dim strFileName As Object, objFolder As Object, i As Byte, e As Integer, ProP$
    Dim collect As New Collection
    Static objShell As Object: Static FsO As Object

    If a = 1 Then
        a = a + 1
        Set objShell = CreateObject("Shell.Application")
        Set FsO = CreateObject("Scripting.FileSystemObject")
        ReDim table(1 To 11, 1 To a) ' Table redimensionné
        table(1, a) = "DOSSIER: " & folder
        table(2, a) = FsO.getfolder(folder).Size / 1000 & " Ko"
        table(11, a) = folder
    End If

    Set objFolder = objShell.Namespace(folder)

    For Each strFileName In objFolder.Items
        If Not strFileName.IsFolder Then
            a = a + 1
            ReDim Preserve table(1 To 11, 1 To a) ' Ajustement dynamique du tableau
            For i = 0 To 250
                Select Case objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Nom": table(1, a) = ". " & objFolder.getDetailsOf(strFileName, i): table(1, 1) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Taille": table(2, a) = objFolder.getDetailsOf(strFileName, i): table(2, 1) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Extension du fichier": table(3, a) = objFolder.getDetailsOf(strFileName, i): table(3, 1) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Commentaires": table(4, a) = objFolder.getDetailsOf(strFileName, i): table(4, 1) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Modifié le": table(5, a) = objFolder.getDetailsOf(strFileName, i): table(5, 1) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Date de création": table(6, a) = objFolder.getDetailsOf(strFileName, i): table(6, 1) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Date d’accès": table(7, a) = objFolder.getDetailsOf(strFileName, i): table(7, 1) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Sorte": table(8, a) = objFolder.getDetailsOf(strFileName, i): table(8, 1) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Notation": table(9, a) = objFolder.getDetailsOf(strFileName, i): table(9, 1) = objFolder.getDetailsOf(objFolder.Items, i)
                    Case "Auteurs": table(10, a) = objFolder.getDetailsOf(strFileName, i): table(10, 1) = objFolder.getDetailsOf(objFolder.Items, i)
                        'Case "Chemin du dossier": table(a, 11) = objFolder.getDetailsOf(strFileName, i): table(1, 10) = objFolder.getDetailsOf(objFolder.Items, i)
                End Select
            Next
            table(11, 1) = "path"


            ' Ajoute d'autres colonnes selon les besoins
            table(11, a) = strFileName.Path
        Else
            collect.Add strFileName.Path
        End If
    Next

    Dim subfolder
    For Each subfolder In collect
        a = a + 1
        ReDim Preserve table(1 To 11, 1 To a)
        table(1, a) = "DOSSIER: " & subfolder
        table(2, a) = FsO.getfolder(subfolder).Size / 1000 & " Ko"
        table(11, a) = subfolder
        ListeProprietesFichiers_getDetailsOf subfolder, table, a
    Next

    ListeProprietesFichiers_getDetailsOf = table ' Retourne le nombre de lignes utilisées
End Function
 
Vote positif 0 Vote négatif
jurassic pork

jurassic pork

XLDnaute Occasionnel
Hello,
je viens d'essayer le DSOFile 64 sur mon Excel 64 bits, cela a l'ai de fonctionner mais je n'ai pas utilisé le .bat pour installer la dll et l'enregistrer car ce qui est bizarre c'est que dans le .bat il installe la dll dans syswow64 et il fait le regsvr32 dans ce répertoire. Hors ce répertoire c'est pour les dll 32 bits. J'ai donc copier la dll dans le répertoire System32 (c'est le répertoire des dll 64 bits sur un O.S 64 bits) et j'ai lancé le regsvr32 dans ce répertoire. La dll a bien été enregistrée et je vois bien dsoFile dans les références de mon Excel 64 bits.
Avec ce code :
VB: 
Private Function fnFileTitle(ByVal strFileName As String) As String
On Error GoTo OnError
   Dim oOleDocProp
   Set oOleDocProp = CreateObject("DSOFile.OleDocumentProperties")
   oOleDocProp.Open (strFileName)
   fnFileTitle = oOleDocProp.SummaryProperties.Title
   oOleDocProp.Close
   If Not oOleDocProp Is Nothing Then Set oOleDocProp = Nothing
Exit Function
OnError:
    MsgBox Err.Number & " - " & Err.Description
    Resume Next
End Function

Sub TestDso()
Debug.Print fnFileTitle("d:\temp\azertybio_jp.xlsm")
End Sub

Voici les propriétés accessibles dans oOleDocProp :
OleDocProp.png


Ami calmant, J.P
 
Dernière édition:
Vote positif 0 Vote négatif
jeff1494

jeff1494

XLDnaute Occasionnel
Bonjour à vous deux;
@patricktoulon :
Merci pour ta dernière version.
Il faut que je vois si les mots-clés sont disponibles avec ce que tu m'as déjà offert.

Pour la recherche sur les commentaires et/ou les mots clés, pour l'instant ce n'est qu'une idée.
Je vais y réfléchir un peu plus pour définir exactement ce que je veux.
Je reviendrais vers toi pour t'expliquer cela, et te demanderai de l'aide le moment venu.
Pour l'instant l'instant je vais voir ton code, et je vais essayer de comprendre tout cela, car si j'ajoute un fichier ZIP cela plante comme je le disais dans le post N° 39.
Je vais donc regarder si il y a des différences entre ce dernier code et celui que tu as posté avec les fichiers ZIP.

Encore merci pour ta patience, et ton aide.
A+
 
Vote positif 0 Vote négatif

Discussions similaires

D
  • Question
Microsoft 365 Afficher les propriétés d'un fichier
Réponses
2
Affichages
329
patricktoulon
patricktoulon
B
  • Question
XL 2016 Propriétés fichiers vidéos.
Réponses
3
Affichages
370
patricktoulon
patricktoulon
B
  • Question
XL 2016 Affichage de la fenêtre "Propriétés" d'un fichier.
Réponses
1
Affichages
364
sylvanu
sylvanu
T
  • Résolu(e)
XL 2010 VAB - Lister et renommer fichiers en bloc
Réponses
6
Affichages
256
tchi456
T
M
  • Question
XL 2021 Creation VBA copie de differents fichiers dans différents dossiers
Réponses
5
Affichages
224
patricktoulon
patricktoulon
P
  • Question
XL 2019 Changer nom d'export en VBA
Réponses
3
Affichages
371
job75
job75
M
  • Résolu(e)
XL 2013 VBA enregistrement fichier dans un dossier en particulier
Réponses
3
Affichages
95
MarineU
M
M
  • Question
XL 2019 VBA/Macro | Créer des fichiers automatiquement
Réponses
2
Affichages
344
Mael44
M
Nicolas JACQUIN
  • Résolu(e)
XL 2021 Compresser le contenu d'un dossier en zip
Réponses
5
Affichages
191
Nicolas JACQUIN
Nicolas JACQUIN
R
  • Question
XL 2019 Extraire propriété d'un mail (Outlook eml)
Réponses
4
Affichages
302
re4
R

Membres actuellement en ligne

16 membres et 119 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
313 866
Messages
2 103 082
Membres
108 521
dernier inscrit
manouba