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

jeff1494 · 12 Août 2024

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 :

Nom du fichier
Extension du fichier
Date de création
Taille du fichier
Répertoire où se trouve le fichier
Date de modification du fichier
Heure de modification du fichier
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 :

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

patricktoulon · 23 Août 2024

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

jeff1494 · 23 Août 2024

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+.

jeff1494 · 23 Août 2024

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.

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.

patricktoulon · 23 Août 2024

re
avec cette méthode même les zip ne résistent pas
bon en tout cas ça à l"air de te convenir vu ta capture

patricktoulon · 23 Août 2024

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

kiki29 · 23 Août 2024

Salut, voir par ici et adapter à ton contexte

jeff1494 · 25 Août 2024

@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+.

patricktoulon · 26 Août 2024

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

jeff1494 · 26 Août 2024

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 :

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.

jeff1494 · 26 Août 2024

@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.

patricktoulon · 27 Août 2024

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

patricktoulon · 27 Août 2024

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

jurassic pork · 27 Août 2024

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 :

Ami calmant, J.P

jeff1494 · 27 Août 2024

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+

TooFatBoy · 27 Août 2024

jeff1494 à dit:
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

Il me semble que ton ne parle d'utiliser DSOFile sur un Windows 64 bits, mais plutôt d'utiliser DSOFile dans un application 64 bits.

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

jeff1494

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

jeff1494

XLDnaute Occasionnel

jeff1494

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

kiki29

XLDnaute Barbatruc

jeff1494

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

jeff1494

XLDnaute Occasionnel

jeff1494

XLDnaute Occasionnel

Pièces jointes

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

jurassic pork

XLDnaute Occasionnel

jeff1494

XLDnaute Occasionnel

TooFatBoy

XLDnaute Barbatruc

Discussions similaires