Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2013 Fonction pour obtenir taille fichier, auteur...

Chrystel01

XLDnaute Occasionnel
Bonjour,

J'ai sur une feuille une liste de noms de fichiers en colonne D et un chemin d'accès en colonne F. Ces fichiers sont fermés.
Il existe 20 000 lignes de noms de fichiers environ mais ne joints qu'un exemple dans le fichier attaché.
J'aurais souhaité récupérer dans les colonnes H à K la taille de chaque fichier, son auteur, la date d'accès et de dernière modification.

Pourriez-vous m'aider svp avec une fonction VBA ? Je ne sais pas comment faire et cela m'éviterait tout un travail manuel.
NB : Je ne souhaite pas passer par power query qui plante et ne va jamais jusqu'au bout du comptage pour des raisons diverses.

Je vous remercie par avance pour votre aide

Bonne journée

Chrystel
 

Pièces jointes

  • test.xlsx
    8.8 KB · Affichages: 25
Solution
Bonjour Christel,
Ci-dessous, le code VBA de la macro listeprop à exécuter.
A noter : Nécessite d'activer la référence Microsoft Shell Controls and Automation
La boucle pour toutes les lignes à adapter (ici de 9 à 10)
VB:
Sub listeprop()
Dim i As Integer
    With ActiveSheet
        For i = 9 To 10
            If .Cells(i, 4) <> "" Then
                .Cells(i, 8) = ListeProprietesFichier_getDetailsOf(.Cells(i, 6) & "/" & .Cells(i, 4), 1)
                .Cells(i, 9) = ListeProprietesFichier_getDetailsOf(.Cells(i, 6) & "/" & .Cells(i, 4), 20)
                .Cells(i, 10) = ListeProprietesFichier_getDetailsOf(.Cells(i, 6) & "/" & .Cells(i, 4), 3)
                .Cells(i, 11) = ListeProprietesFichier_getDetailsOf(.Cells(i...

Gégé-45550

XLDnaute Accro
Et pour l'auteur de la dernière modif, pas d'idée ?
Bonsoir,
Essayez ça (sans oublier d'activer le Microsoft Scripting Runtime et d'ajouter une colonne supplémentaire à droite du TS) :
VB:
Const Col_Nom = 4, Col_Path = 5, Col_Path_R = 6
Const Col_Taille = 7, Col_AUTEUR = 8, Col_DateCréation = 9, Col_DateModif = 10, Col_DateAccès = 11, Col_Der_Mod = 12
Const pTaille = 1, pDateModif = 3, pDateCréation = 4, pDateAccès = 5, pAuteur = 20

Sub LirePropriétésFichiersFermés()
    
Dim oShell As Object, oFolder As Object, oFolderItem As Object
Dim FSo As Object, FSoFi As Object
Dim tablo, NomFich$, lgn%
Dim Cible As Scripting.FileSystemObject
Dim Valeur As Scripting.File
Dim Resultat As String
Dim Modifie_Par As String

     Set Cible = CreateObject("Scripting.fileSystemObject")
     Set oShell = CreateObject("Shell.Application")
     Set FSo = CreateObject("Scripting.FileSystemObject")
    
     'Récupérer les données du tableau structuré "_Liste"
     tablo = sh_LstFich.[_Liste]
    
     For lgn = 1 To UBound(tablo)
          
          NomFich = tablo(lgn, Col_Path_R) & "\" & tablo(lgn, Col_Nom)
          Set Valeur = Cible.GetFile(NomFich)
          Modifie_Par = ActiveWorkbook.BuiltinDocumentProperties("Last Author").Value
          If FSo.FileExists(NomFich) Then
               Set oFolder = oShell.Namespace(tablo(lgn, Col_Path_R))
               Set oFolderItem = oFolder.Items.Item(tablo(lgn, Col_Nom))
               Set FSoFi = FSo.GetFile(NomFich)
              
               tablo(lgn, Col_Taille) = Format(CLng(FSoFi.Size), "#,###") & " (" & oFolder.GetDetailsOf(oFolderItem, pTaille) & ")"
               tablo(lgn, Col_AUTEUR) = oFolder.GetDetailsOf(oFolderItem, pAuteur)
               tablo(lgn, Col_DateCréation) = FSoFi.DateCreated
               tablo(lgn, Col_DateModif) = FSoFi.dateLastModified
               tablo(lgn, Col_DateAccès) = FSoFi.DateLastAccessed
               tablo(lgn, Col_Der_Mod) = Modifie_Par
              
               Set objFolder = Nothing: Set oFolderItem = Nothing: Set FSoFi = Nothing
          End If
     Next
     Set oShell = Nothing: Set FSo = Nothing
     'Coller les résultat dans le tableau
     sh_LstFich.[_Liste].Value = tablo
    
End Sub
Cordialement,
 

AtTheOne

XLDnaute Accro
Supporter XLD
Bonsoir @Gégé-45550
Merci, mais si je ne me trompe pas, ça ne fonctionne que pour un classeur ouvert, nous cherchons des solutions pour des fichiers fermés. Ici ça ne renvoie que le dernier auteur du classeur actif.

Je ne comprends pas à quoi sert
  • de créer un autre FileSystemObject, il y en a un de créer "FSo"
  • Set valeur = Cible.GetFile(NomFich), dans la boucle je fais Set FSoFi = FSo.GetFile(NomFich)
Pourrais-tu m'éclairer ?
Encore merci pour ta réponse

À bientôt
 

Chrystel01

XLDnaute Occasionnel
Bonjour Crocrocro,

C'est génial !!!
Merci beaucoup pour ce code fantastique.
Dans le même temps, j'ai découvert les bibliothèques en cherchant sur internet comment faire pour " activer la référence Microsoft Shell Controls and Automation"

Un grand merci pour votre aide précieuse et votre réactivité

Bonne semaine !

Chrystel
 

Chrystel01

XLDnaute Occasionnel
Bonjour Crocrocro,

C'est génial !!!
Merci beaucoup pour ce code fantastique.
Dans le même temps, j'ai découvert les bibliothèques en cherchant sur internet comment faire pour " activer la référence Microsoft Shell Controls and Automation"

Un grand merci pour votre aide précieuse et votre réactivité

Bonne semaine !

Chrystel
 

Gégé-45550

XLDnaute Accro
Bonjour,
tu as raison.
J'ai fais ça tard cette nuit (tôt ce matin ?) et ma proposition est pourrie, à oublier.
Je cherche autre chose ASAP.
Cordialement,
 

Gégé-45550

XLDnaute Accro
Bonjour @Gégé-45550 ,
Moi aussi j'ai veillé, je t'ai répondu de mon téléphone, ta proposition a au moins le mérite d'exister !
À bientôt
Re ...
C'est agaçant, on peut obtenir (entre autres), tout ça :

Nom du fichierLire Propriétés.xlsm
Taille18,3 Ko
Type d’élémentFeuille de calcul Microsoft Excel prenant en charge les macros
Modifié le18/05/2024 00:59
Date de création18/05/2024 00:59
Date d’accès18/05/2024 10:53
AttributsA
État hors connexion
Disponibilité
Type identifiéDocument
PropriétaireDESKTOP-GG\GG
SorteDocument
Prise de vue
Interprètes ayant participé
Album
Année
Genre
Chefs d’orchestre
Mots clés
NotationNon classé
AuteursDUVEAU Chrystel
Titre
Objet
Catégories
Commentaires
Copyright
Durée
Débit binaire
Protégé
Modèle d'appareil photo
Dimensions
Marque appareil photo
EntrepriseVille de Lyon
Description du fichier
Mots-clés des formes de base
Mots-clés des formes de base
Nom du programmeMicrosoft Excel
Durée
Connecté
Périodique
Emplacement
Adresses des participants facultatifs
Participants facultatifs
Adresse de l’organisateur
Nom de l’organisateur
Heure du rappel

... mais RIEN sur l'auteur du dernier enregistrement
 

Chrystel01

XLDnaute Occasionnel
Bonjour le fil,

Je vous remercie beaucoup pour toutes vos réponses et les codes VBA .
Cela fonctionne parfaitement et sera d'une grande utilité
Mon seul souci est de le lancer le code de multiples fois car ça va très vite pour quelques lignes mais pour 1000 lignes ca met plus d'une heure (j'ai "pas de réponse" dans excel) ... et j'ai plus de 20 000 lignes au total...
Je vais peut être essayer de la lancer de nuit pour ne pas bloquer les ressources de l'ordi.

Bonne journée

Chrystel
 

AtTheOne

XLDnaute Accro
Supporter XLD
Bonjour @Chrystel01
Ma version, pour 954 fichiers, a mis 3 minutes, l'as-tu essayée ?
A bientôt
EDIT : et sans l'auteur obtenu par shell c'est quasi instantané
VB:
Const Col_Nom = 4, Col_Path = 5, Col_Path_R = 6
Const Col_Taille = 7, Col_AUTEUR = 8, Col_DateCréation = 9, Col_DateModif = 10, Col_DateAccès = 11
Const pTaille = 1, pDateModif = 3, pDateCréation = 4, pDateAccès = 5, pAuteur = 20

Sub LirePropriétésFichiersFermés()
    
     Dim oShell As Object, oFolder As Object, oFolderItem As Object
     Dim FSo As Object, FSoFi As Object
     Dim tablo, NomFich$, lgn%
    
'     Set oShell = CreateObject("Shell.Application")
     Set FSo = CreateObject("Scripting.FileSystemObject")
    
     'Récupérer les données du tableau structuré "_Liste"
     tablo = sh_LstFich.[_Liste]
    
     For lgn = 1 To UBound(tablo)
          
          NomFich = tablo(lgn, Col_Path_R) & "\" & tablo(lgn, Col_Nom)
          If FSo.FileExists(NomFich) Then
'               Set oFolder = oShell.Namespace(tablo(lgn, Col_Path_R))
'               Set oFolderItem = oFolder.Items.Item(tablo(lgn, Col_Nom))
               Set FSoFi = FSo.GetFile(NomFich)
              
               tablo(lgn, Col_Taille) = Format(CLng(FSoFi.Size), "#,###")
'               tablo(lgn, Col_Taille) = Format(CLng(FSoFi.Size), "#,###") & " (" & oFolder.GetDetailsOf(oFolderItem, pTaille) & ")"
'               tablo(lgn, Col_AUTEUR) = oFolder.GetDetailsOf(oFolderItem, pAuteur)
               tablo(lgn, Col_DateCréation) = FSoFi.DateCreated
               tablo(lgn, Col_DateModif) = FSoFi.DateLastModified
               tablo(lgn, Col_DateAccès) = FSoFi.DateLastAccessed
              
               Set objFolder = Nothing: Set oFolderItem = Nothing: Set FSoFi = Nothing
          End If
     Next
     Set oShell = Nothing: Set FSo = Nothing
     'Coller les résultat dans le tableau
     sh_LstFich.[_Liste].Value = tablo
    
End Sub
 

Discussions similaires

Réponses
19
Affichages
2 K
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…