Sub ListeProprietesFichiers_getDetailsOf()

   'source:
   'http://www.microsoft.com/resources/documentation/windows/2000/server/
   'scriptguide/en-us/sas_fil_lunl.mspx
   '
   'Nécessite d'activer la référence Microsoft Shell Controls and Automation
   '
   Dim objShell 'As Shell32.Shell
   Dim strFileName 'As Shell32.FolderItem
   Dim objFolder 'As Shell32.Folder
   Dim Resultat As String, Reponse As String
   Dim i As Byte
   
   Set objShell = CreateObject("Shell.Application")
   'Répertoire cible
   Set objFolder = objShell.nameSpace("Z:\Projets\e-Learning\Documentations")
   
   Set wrdRange = Application.ActiveDocument.Range
   Set wrdTable = Application.ActiveDocument.Tables.Add(Range:=wrdRange, NumRows:=objFolder.Items.Count, NumColumns:=4)
   
   wrdTable.Cell(1, 1).Range.InsertAfter "Item"
   wrdTable.Cell(1, 4).Range.InsertAfter "Date de modification"
   wrdTable.Cell(1, 3).Range.InsertAfter "Description"
   wrdTable.Cell(1, 2).Range.InsertAfter "Titre"
   
   Dim ifile As Integer
   ifile = 2
   
   'boucle sur tous les elements du repertoire
   For Each strFileName In objFolder.Items
       
       'Pour que les dosssiers ne soient pas pris en comptes
       If strFileName.isFolder = False Then
       Resultat = ""
       titre = ""
       Description = ""
       modif = ""
       
       For i = 0 To 64
           If objFolder.getDetailsOf(strFileName, i) <> "" Then
               Select Case LCase(Resultat & objFolder.getDetailsOf(objFolder.Items, i))
                   Case "titre"
                       titre = objFolder.getDetailsOf(strFileName, i)
                   Case "objet"
                       Description = objFolder.getDetailsOf(strFileName, i)
                   Case "modifié le"
                       modif = objFolder.getDetailsOf(strFileName, i)
                   Case Else
                       res = objFolder.getDetailsOf(objFolder.Items, i)
                       res = ""
               End Select
           End If
       Next
       wrdTable.Cell(ifile, 1).Range.InsertAfter strFileName
       wrdTable.Cell(ifile, 2).Range.InsertAfter titre
       wrdTable.Cell(ifile, 3).Range.InsertAfter Description
       wrdTable.Cell(ifile, 4).Range.InsertAfter modif
       ifile = ifile + 1

' Reponse = MsgBox(Resultat & vbLf & vbLf & "Voulez vous continuer?", vbYesNo) ' If Reponse = vbNo Then Exit Sub

       End If
   Next
   wrdTable.Style = "Trame claire - Accent 2"

End Sub