Hello patrick,Bonjour à tous
résultat des tests ce matin
avant au premier lancement on avait un phénomène de lourdeur au premier lancement d'une fonction avec le dir vba qui pouvait aller jusqu’à 15 secondes
et donc ce matin a froid on tombe à 106 ms puis on revient entre 40/65 ms les lancements suivants
je valide donc l'astuce
ben non , c'est même plus lent : pour rechercher dans D:\dev les fichiers d'extension xlsm (176) cela met 120 ms.chez toi 105ms pour 8000 fichier "alors en recherche pour trouver une dizaine on doit passer pas loin des 20/30ms non ?
essaie pour voir
je joins le fichier avec les différents fonctions +test benchmark incorporéIDnr Name Count Sum of tics Percentage Time sum
0 debut DirListRecall méthode recursive ancienne et classique 1 225 0,00% 22 us
1 fin DirListRecall 1 22 494 217 100,00% 2,25 s
TOTAL 2 22 494 442 100,00% 2,25 s
Total time recorded: 2,25 s
'-----------------------------------------------------------------------------------------------------------------------------
IDnr Name Count Sum of tics Percentage Time sum
0 appel dirlistold mon ancienne méthode collection de folder 1 139 0,01% 14 us
1 dirlistold terminé 1 2 032 697 99,99% 203 ms
TOTAL 2 2 032 836 100,00% 203 ms
Total time recorded: 203 ms
'----------------------------------------------------------------------------------------------------------------------------
IDnr Name Count Sum of tics Percentage Time sum
0 debut DirPileListDIR tout les fichiers methode perso en pile 1 118 0,02% 12 us
1 fin de DirPileListDIR 1 662 659 99,98% 66 ms
TOTAL 2 662 777 100,00% 66 ms
Total time recorded: 66 ms
IDnr Name Count Sum of tics Percentage Time sum
0 debut DirListRecall méthode recursive ancienne et classique 1 3 871 0,00% 387 us
1 fin DirListRecall 1 380 487 511 100,00% 38 s
TOTAL 2 380 491 382 100,00% 38 s
Total time recorded: 38 s
IDnr Name Count Sum of tics Percentage Time sum
0 debut DirListRecall méthode recursive ancienne et classique 1 134 0,00% 13 us
1 fin DirListRecall 1 344 490 261 100,00% 34,4 s
TOTAL 2 344 490 395 100,00% 34,4 s
Total time recorded: 34,4 s
IDnr Name Count Sum of tics Percentage Time sum
0 debut DirListRecall méthode recursive ancienne et classique 1 102 0,00% 10 us
1 fin DirListRecall 1 346 607 416 100,00% 34,7 s
TOTAL 2 346 607 518 100,00% 34,7 s
Total time recorded: 34,7 s
Bonsoir,en tout cas 14k affichage en 20 jours ;faut croire que le sujet en intéresse plus d'un
Function APIFilterFileListByName(Path As String, Optional SearchString = "*", Optional extension = "*.*", Optional Recursif As Boolean = False, Optional TbL As Variant)
Dim FindData As WIN32_FIND_DATA, FileName$, FullPath$, Debut&, X&, Att
#If VBA7 Then
Dim hFind As LongPtr
#Else
Dim hFind As Long
#End If
On Error Resume Next
'si tbl n'est pas un array c'est que c'est le debut alors on le redim en tableau a zero
If Not IsArray(TbL) Then ReDim TbL(0): Debut = 1
If SearchString = "" Then SearchString = "*"
' Ajouter le separateur si il est manquant
If Right(Path, 1) <> "\" Then Path = Path & "\"
' Ajout de l'argument All (*.*) pour la recherche
Path = Path & "*.*"
' Démarrer la recherche
hFind = FindFirstFile(Path, FindData)
If hFind <> -1 Then
Do
' Extraire le nom du fichier
FileName = Left(FindData.cFileName, InStr(FindData.cFileName, vbNullChar) - 1)
' Ignorer les dossiers "." et ".."
If FileName <> "." And FileName <> ".." And Not FileName Like "*$*" Then
'Concat du fullpath
FullPath = Left(Path, Len(Path) - 4) & "\" & FileName ' concatainer le chemin complet
'Vérifier si ce n'est pas un dossier
'addition logique de l'attribut + vbdirectory (permet d'exclure les dossiers les fichiers system)
Att = (FindData.GetAttribute And vbDirectory)
If Att <> vbDirectory Then
' Vérifier si le nom du fichier contient la chaîne recherchée
If " " & LCase(FileName) Like LCase("*" & SearchString & "*" & extension & "*") Then
'ajouter au tableau si c'est un fichier
X = UBound(TbL) + 1: ReDim Preserve TbL(1 To X): TbL(X) = FullPath
End If
Else
' Appel récursif si c'est un dossier
If Recursif Then APIFilterFileListByName FullPath & "\", SearchString, extension, Recursif, TbL
End If
End If
Loop While FindNextFile(hFind, FindData)
'Fermer le handle de recherche
FindClose hFind
End If
' Return
If Debut = 1 Then APIFilterFileListByName = TbL
On Error GoTo 0
End Function