ReDim Preserve d'un tableau à 2 dimensions dans une boucle

Très chers internautes,

Je me replonge dans le bain du code VBA après un long moment d'abstinence de dev... et je me heurte à un soucis que je n'arrive pas à résoudre.

Mon problème est pourtant assez simple.

Je veux boucler sur tous les fichiers d'un répertoire donné.
Ccomparer la date de dernière modification du fichier par rapport à une date pivot.
Et si le fichier est plus récent que celle-ci, j'aimerais alimenter un tableau avec 3 données :
- Le nom du fichier
- La date de dernière modification du fichier
- La date de création du fichier

Ensuite, je voudrais parcourir ce tableau et alimenter une feuille Excel avec les 3 infos de chaque fichier.

Je vous présente mon code :

Sub MonitorFolder()
    Dim folderPath As String
    Dim fso As Object
    Dim folder As Object
    Dim file As Object
    Dim latestFileDate As Date
    Dim newFiles() As Variant ' Tableau dynamique pour stocker les fichiers
    Dim rowCount As Long ' Nombre de lignes ajoutées
    Dim i As Long

    folderPath = Range("folder_path").Value & Range("subFolder_path").Value ' Chemin d'accès
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(folderPath)
    rowCount = 0

    ' Récupérer la date pivot
    latestFileDate = Worksheets("TARIF CHECK").Range("LatestDate").Value

    ' Vérifier chaque fichier dans le dossier
    For Each file In folder.Files
        ' Si un fichier est plus récent que la dernière vérification
        If file.DateLastModified > latestFileDate Then
            rowCount = rowCount + 1
            Debug.Print rowCount
            ' Ajout du fichier au tableau
            ReDim Preserve newFiles(1 To rowCount, 1 To 3)
            newFiles(rowCount, 1) = file.Name
            newFiles(rowCount, 2) = file.DateLastModified
            newFiles(rowCount, 3) = file.DateCreated
        End If
    Next file

    ' Afficher tous les nouveaux fichiers
    For i = 1 To rowCount
        Debug.Print "Ligne " & i & ": " & newFiles(i, 1) & " | " & newFiles(i, 2) & " | " & newFiles(i, 3)
    Next i
End Sub

Le Debug.Print me donne 1 et 2, m'indiquant qu'il a bien su parcourir la boucle une fois et alimenter le tableau newFiles. Mais il plante au second passage, indiquant "L'indice n'appartient pas à la sélection".

Et je sèche là dessus depuis des heures.

J'ai essayé d'instancier mon tableau une première fois avant d'entrer dans la boucle, j'ai aussi essayé de ne redimensionner que la 1ère dimension, ainsi que d'échanger les dimensions pour redimensionner la seconde plutôt que la première... Et rien n'y fait.

Même ChatGPT n'a pas su m'aider :o

Avez-vous une idée pour corriger cela ?

Merci pour votre aide.

Hello,

au lieu d'utiliser un tableau , tu pourrais utiliser une collection et pour les données une classe avec les 3 Infos:

Module de classe ClInfoFile :

Public Name As String
Public DateLastModified As Date
Public DateCreated As Date

Exemple d'utilisation :

Sub AfficheFilesInfos()     
    Dim folderPath As String
    Dim fso As Object, folder As Object, file As Object
    Dim colFiles As New Collection
    Dim InfoFile As ClInfoFile

    folderPath = "d:\temp\"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(folderPath)

    For Each file In folder.Files
        Set InfoFile = New ClInfoFile
        InfoFile.Name = file.Name
        InfoFile.DateLastModified = file.DateLastModified
        InfoFile.DateCreated = file.DateCreated
        colFiles.Add InfoFile
    Next file
 For Each InfoFile In colFiles
      Debug.Print InfoFile.Name & " | " & _
      InfoFile.DateLastModified & " | " & InfoFile.DateCreated
 Next
End Sub

Ami Calmant, J.P

bonjour,

edit : Hello Jurrasic Pork, collision

redim preserve ne fonctionne que pour la 2ème dimension. Si tu redimensionne la première d'un tableau déjà dimensionné, tu reçois un message d'erreur 9.

voici une correction de ton code qui fonctionne chez moi.

Sub MonitorFolder()
    Dim folderPath As String
    Dim fso As Object
    Dim folder As Object
    Dim file As Object
    Dim latestFileDate As Date
    Dim newFiles() As Variant ' Tableau dynamique pour stocker les fichiers
    Dim rowCount As Long ' Nombre de lignes ajoutées
    Dim i As Long

   folderPath = Range("folder_path").Value & Range("subFolder_path").Value ' Chemin d'accès

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(folderPath)
    rowCount = 0

    ' Récupérer la date pivot
    latestFileDate = Worksheets("TARIF CHECK").Range("LatestDate").Value
    ' Vérifier chaque fichier dans le dossier
    For Each file In folder.Files
        ' Si un fichier est plus récent que la dernière vérification
        If file.DateLastModified > latestFileDate Then
            rowCount = rowCount + 1
            Debug.Print rowCount
            ' Ajout du fichier au tableau
            ReDim Preserve newFiles(1 To 3, 1 To rowCount)
            newFiles(1, rowCount) = file.Name
            newFiles(2, rowCount) = file.DateLastModified
            newFiles(3, rowCount) = file.DateCreated
        End If
    Next file

    ' Afficher tous les nouveaux fichiers
    For i = 1 To rowCount
        Debug.Print "Ligne " & i & ": " & newFiles(1, i) & " | " & newFiles(2, i) & " | " & newFiles(3, i)
    Next i
End Sub

Rebonjour,

Merci à tous les deux pour vos réponses.

J'ai opté pour la solution de h2so4, qui fonctionne en effet très bien. Il faut croire que j'avais laissé une coquille lorsque j'ai voulu inverser l'ordre des dimensions parce que ton commentaire correspond à d'autres que j'ai pu lire sur le même sujet et pour lequel j'avais fait un essai...

Soit, le problème est résolu :)

Bonne fin de journée,