VBA Excel à l'aide de FileSystemObject de fichier de la liste de la dernière date de modification

c'est ma première fois de poser la question, alors j'espère que je suis en suivant le protocole.
C'est en référence à "obtenir la liste des sous-dossiers dans vba" obtenir la liste des sous-dossiers dans vba.

J'ai trouvé Brett exemple #1 - à l'Aide de FileScriptingObject le plus utile. Mais il y a plus d'élément de données (DateLastModified) j'ai besoin de résultats. J'ai essayé de modifier le code, mais reçois des invalides qualifier d'erreur. Voici les modifications de code que j'ai fait:

  1. Range("A1:C1") = Array("Nom Du Fichier", "Chemin", "Date De La Dernière Modification").
  2. Boucle Do While ajouté ça => Cells(i, 3) = myFile.DateLastModified.

Apprécieront aider à inclure la "Date de la Dernière modification".

Santosh ici est de compléter le code avec des commentaires indiquant les modifications.

Public Arr() As String
Public Counter As Long

Sub LoopThroughFilePaths()
Dim myArr
Dim i As Long
Dim j As Long
Dim MyFile As String
Const strPath As String = "c:\temp\"
myArr = GetSubFolders(strPath)
Application.ScreenUpdating = False
'Range("A1:B1") = Array("text file", "path")' <= orig code
Range("A1:C1") = Array("text file", "path", "Date Last Modified") ' <= modified code
    For j = LBound(Arr) To UBound(Arr)
        MyFile = Dir(myArr(j) & "\*.txt")
        Do While Len(MyFile) <> 0
        i = i + 1
            Cells(i, 1) = MyFile
            Cells(i, 2) = myArr(j)
            Cells(i, 3) = MyFile.DateLastModified ' <= added to modify code
            MyFile = Dir
        Loop
    Next j
Application.ScreenUpdating = True
End Sub

Function GetSubFolders(RootPath As String)
Dim fso As Object
Dim fld As Object
Dim sf As Object
Dim myArr

Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(RootPath)
For Each sf In fld.SubFolders
    Counter = Counter + 1
    ReDim Preserve Arr(Counter)
    Arr(Counter) = sf.Path
    myArr = GetSubFolders(sf.Path)
Next
GetSubFolders = Arr
Set sf = Nothing
Set fld = Nothing
Set fso = Nothing
End Function
U peut mettre le code complet ainsi que les changements que vous avez faits ?
Santosh ci-dessous est à compléter le code avec les modifications

OriginalL'auteur user2397403 | 2013-05-18

  1. 7

    Essayez ce code :

    Sub ListFilesinFolder()

    Dim FSO As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim FileItem As Scripting.File

    SourceFolderName = "C:\Users\Santosh"

    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)

    Range("A1:C1") = Array("text file", "path", "Date Last Modified")

    i = 2
    For Each FileItem In SourceFolder.Files
        Cells(i, 1) = FileItem.Name
        Cells(i, 2) = FileItem
        Cells(i, 3) = FileItem.DateLastModified
        i = i + 1
    Next FileItem

    Set FSO = Nothing

End Sub
    Santosh, votre code a fonctionné. Merci beaucoup!

    OriginalL'auteur Santosh