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

C

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
C
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...
Trier par date Trier par votes
C

crocrocro

XLDnaute Occasionnel
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, 6) & "/" & .Cells(i, 4), 5)
            End If
        Next i
    End With
End Sub
Function ListeProprietesFichier_getDetailsOf(Fichier As String, pProp As Integer) As String
    'Nécessite d'activer la référence Microsoft Shell Controls and Automation
    Dim Fso As Object, oFichier As Object
    Dim objShell As Shell32.Shell
    Dim objFolder As Shell32.Folder
    Dim strFileName As Shell32.FolderItem
    Dim Chemin As String, NomFich As String
  
    '-----
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set oFichier = Fso.GetFile(Fichier)
    Chemin = Fso.GetParentFolderName(oFichier)
    NomFich = Fso.GetFileName(oFichier)
    '-----
  
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(Chemin)
    Set strFileName = objFolder.Items.Item(NomFich)
    'https://www.devhut.net/how-to-retrieve-a-files-properties-with-vba/
    ' 1 = taille
    ' 3 = date de modif
    ' 4 = date de création
    ' 5 = date d'accès
    ' 20 = auteur

    ListeProprietesFichier_getDetailsOf = objFolder.GetDetailsOf(strFileName, pProp)

    Set Fso = Nothing
    Set oFichier = Nothing
    Set objShell = Nothing
    Set objFolder = Nothing
    Set strFileName = Nothing

End Function
 
Vote positif 0 Vote négatif
Solution
job75

job75

XLDnaute Barbatruc
Bonjour Chrystel01, crocrocro, le forum,

Chez moi sur Win 11 et Excel 2019 il n'est pas nécessaire de cocher la référence "Microsoft Shell Controls and Automation".

Et il n'est pas nécessaire d'utiliser la bibliothèque "Scripting.FileSystemObject", voyez ce code :
VB: 
Sub listeprop1()
Dim objShell As Object, i As Long, objFolder As Object, strFileName As Object
    Set objShell = CreateObject("Shell.Application")
    Application.ScreenUpdating = False
    With ActiveSheet
        For i = 9 To 20000
            If .Cells(i, 4) <> "" Then
                Set objFolder = objShell.Namespace(CStr(.Cells(i, 6)))
                Set strFileName = objFolder.Items.Item(CStr(.Cells(i, 4)))
                .Cells(i, 8) = objFolder.GetDetailsOf(strFileName, 1)
                .Cells(i, 9) = objFolder.GetDetailsOf(strFileName, 20)
                .Cells(i, 10) = objFolder.GetDetailsOf(strFileName, 3)
                .Cells(i, 11) = objFolder.GetDetailsOf(strFileName, 5)
                Set objFolder = Nothing
                Set strFileName = Nothing
            End If
        Next i
    End With
End Sub

' 1 = taille
' 3 = date de modif
' 4 = date de création
' 5 = date d'accès
' 20 = auteur
Si un chemin n'existe pas un bug se produit.

Avec 20 000 fichiers le traitement prendra plusieurs dizaines de secondes.

A+
 
Dernière édition:
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
Bonjour,

Merci job75 pour cette macro qui fonctionne nickel chez moi avec Excel 2016. 👍

Capture.png

(j'ai ajouté une colonne pour la date de création)


Bonne soirée
 
Dernière édition:
Vote positif 0 Vote négatif
AtTheOne

AtTheOne

XLDnaute Accro
Supporter XLD
Bonsoir à toutes & à tous, bonsoir @Chrystel01,
Bon comme d'hab j'arrive après la bagarre mais je propose aussi ma solution (qui ressemble étrangement à celles qui précèdent !
J'ai transformé ta liste en tableau structuré (nommé _Liste)
Je teste l'existence du fichier.
Je mets la taille en octets et en Ko, Mo, Go

le code :
EDIT : VOIR post10 bug corrigé !
VB: 
nous 
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), "#,###") & " (" & 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

Voir le fichier exemple.

PS: @job75 , @TooFatBoy , @crocrocro
Je n'ai pas trouvé de méthode pour récupérer l'auteur de la dernière modification dans un fichier fermé,
quelqu'un a-t-il une idée ?

A bientôt
 

Pièces jointes

  • Lire Propriétés Fichiers Fermés.xlsm
    18.4 KB · Affichages: 7
Dernière édition:
Vote positif 0 Vote négatif
AtTheOne

AtTheOne

XLDnaute Accro
Supporter XLD
Re,
TooFatBoy à dit:
Marche pas chez moi. :(
Cliquez pour agrandir...

Après correction d'un copier-coller malheureux ...
Le code :
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), "#,###") & " (" & 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

Et pour l'auteur de la dernière modif, pas d'idée ?

A bientôt
 

Pièces jointes

  • Lire Propriétés Fichiers Fermés.xlsm
    19.2 KB · Affichages: 4
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
Le petit pb qui bloquait, c'était juste un "bj" en trop ?
Merci pour ta version qui fonctionne parfaitement. 👍

Tant que tu es là, je n'ai pas compris comment tu mets en ko, Mo, Go.
Et à ce sujet, peut-on corriger la valeur, ou cela vient-il de Microsoft qui fait la même erreur que dans son Explorateur de fichiers ?
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
Microsoft 365 Questions générales Power Query
Réponses
4
Affichages
485
merinos
merinos
D
  • Question
Microsoft 365 Changement lien hypertexte en fonction nom feuille Excel
Réponses
1
Affichages
798
gbinforme
G
E
  • Question
XL 2010 Fonction Cellule("filename",...) et adresse locale Onedrive
Réponses
7
Affichages
900
Eric VIMARD
E
Usine à gaz
  • Résolu(e)
Microsoft 365 lister des fichiers
2
Réponses
19
Affichages
2 K
Usine à gaz
Usine à gaz
J
  • Question
Power Query Split des données Power query en différents onglet ou fichiers excel
2 3
Réponses
38
Affichages
4 K
chris
chris
Deadpool_CC
  • Question
XL 2016 Pilotage via VBA d'une connexion Power Query à Salesforce
Réponses
6
Affichages
1 K
Hasco
Hasco
C
  • Résolu(e)
XL 2013 Code vba pour ouvrir un fichier PDF
2
Réponses
15
Affichages
3 K
kiki29
kiki29
P
  • Question
XL 2010 Macro et fichier .csv
2
Réponses
20
Affichages
3 K
papypog
P
Usine à gaz
  • Question
Microsoft 365 Power Query : lister des fichiers
Réponses
7
Affichages
1 K
Usine à gaz
Usine à gaz
C
  • Question
Microsoft 365 Power Query : Chemin du dossier à atteindre dans une cellule nommée Chemin
Réponses
5
Affichages
4 K
CHALET53
C

Membres actuellement en ligne

14 membres et 237 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
314 708
Messages
2 112 101
Membres
111 417
dernier inscrit
LYTH