Optimisation de code VBA ne fonctionne pas
Bonjour à tous,
Je m'excuses par avance d'ouvrir une nouvelle discussion sur l'optimisation de code VBA, mais ma question porte plutôt sur : pourquoi ma modification n'améliore pas le temps d'exécution de ma macro ?
Le contexte est que ma macro liste tous les fichiers d'une arborescence. Or cette arborescence est souvent très lourde avec plusieurs dizaines de milliers de fichiers.
J'avais un programme comme base de travail, je vous montre ici la fonction intéressante qui récursivement va chercher tous les fichiers :
Code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43
| Private Function ScanFolder(FolderName As String)
Dim oFSO As Scripting.FileSystemObject
Dim ObjDossier As Object
Dim ElementFichier As File
Dim ElementDossier As Folder
Dim ligne As Integer
Dim Taille As Long
Dim nomFic As String
Dim dossierFic As String
Dim typeFic As String
Dim dateModif As Date
Set oFSO = New Scripting.FileSystemObject
For Each ElementFichier In oFSO.GetFolder(FolderName).Files
If Range("A4").End(xlDown).Row > 65500 Then
ligne = 5
Else
ligne = Range("A4").End(xlDown).Row + 1
End If
nomFic = ElementFichier.Name
dossierFic = ElementFichier.ParentFolder & "\"
typeFic = ElementFichier.Type
Taille = Round(ElementFichier.Size / 1024, 2)
dateModif = ElementFichier.DateLastModified
Range("A" & ligne).Value = nomFic
Range("B" & ligne).Value = "Ouvrir"
Range("C" & ligne).Value = dossierFic
Range("D" & ligne).Value = typeFic
If Taille < 1024 Then
Range("E" & ligne).Value = Taille & " Ko"
Else
Range("E" & ligne).Value = Round(Taille / 1024, 2) & " Mo"
End If
Range("F" & ligne).Value = dateModif
Next ElementFichier
For Each ElementDossier In oFSO.GetFolder(FolderName).SubFolders
ScanFolder ElementDossier.Path
Next ElementDossier
End Function |
La partie intéressante est que chaque cellule de la feuille est modifier une par une. Or selon mes recherches ceci pourrait expliqué la lenteur du programme. J'ai donc modifier cette fonction pour arriver à ça :
Code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36
| Private Function ScanFolder(FolderName As String, tableau As Variant)
Dim oFSO As Scripting.FileSystemObject
Dim ElementFichier As File
Dim ElementDossier As folder
Dim ligne As Long
Dim Taille As Long
Dim tailleTab As Long
Set oFSO = New Scripting.FileSystemObject
For Each ElementFichier In oFSO.GetFolder(FolderName).files
Taille = Round(ElementFichier.Size * 0.0009765625, 2)
tailleTab = UBound(tableau, 2)
tableau(0, tailleTab) = ElementFichier.Name
tableau(2, tailleTab) = ElementFichier.ParentFolder & "\"
tableau(3, tailleTab) = ElementFichier.Type
If Taille < 1024 Then tableau(4, tailleTab) = Taille & " Ko" Else tableau(4, tailleTab) = Round(Taille * 0.0009765625, 2) & " Mo"
tableau(5, tailleTab) = ElementFichier.DateLastModified
ReDim Preserve tableau(8, tailleTab + 1)
Next ElementFichier
For Each ElementDossier In oFSO.GetFolder(FolderName).SubFolders
ScanFolder ElementDossier.path, tableau
Next ElementDossier
Range("A5").Resize(UBound(tableau, 2), UBound(tableau, 1)) = Application.Transpose(tableau)
Set oFSO = Nothing
End Function |
Je passe en paramètre de cette fonction un tableau dynamique de deux dimensions. La fonction ne modifie donc que ce tableau et ensuite à la toute fin va recopier le tableau sur la feuille.
La fonction marche bien, mais théoriquement et à en croire de nombreux sites le gains de temps devrait être considérable puisqu'on passe de 6 modifications de feuille par fichier à une seule pour tout le programme.
Mais malheureusement je n'observe aucun gains de temps lors de l'exécution de la macro. Je viens donc vers vous afin de savoir si vous auriez une idée du pourquoi ? Si j'ai loupé quelque chose, ou mal compris.. Je n'en sais rien..
Quelques infos complémentaires :
- Les fichiers sont situés sur un serveur distant ce qui peut expliquer que l'exécution soit plus longue qu'en local, mais ça n'explique pas pourquoi ce temps ne diminu pas.
- J'ai essayé aussi beaucoup d'autres méthodes afin d'optimiser le temps (dont certaines que vous pouvez voir dans le code), mais ma question porte principalement sur la partie que je vous explique plus haut.
En tout cas merci d'avance pour votre aide,
Cordialement,