Autres Tests de diverses solution pour lister dans un dialog perso des fichiers en filtrant par expression et extension

patricktoulon

XLDnaute Barbatruc
Bonjour à tous
si il y a des âmes charitables qui voudraient bien tester ma pseudo boite de dialogue fichier avec filtre ca m'arrangerait
en fait je l'ai créée sous trois formae différente

1° la filedilogspecial1
avec un dir en ligne de commande lancée par wscript.shell(.excec) et récupérée par le stdout.readall
ce qui implique une apparition brève mais tout de même de la fenêtre dos

2° la filedilogspecial2
avec un dir en ligne de commande lancée par wscript.shell (.run)et récupérée dans un fichier text temporaire
ce qui implique que la fenêtre dos n'apparait pas puisque je hide la fenêtre

3° la filedilogspecial3
dans celle ci j'utilise un hersats de ma fonction FSOGOSUB de 2021 avec FSO

tout les argument sont optionnels
le choix du fichier se fait au double click
possibilité d'annuler

vous avez 3 module pour tester chaque version
si vous pouviez donc tester la testA4 , TestB4 , TestC4 qui sont selon moi les plus importantes
et me dire si la différence de temps d'apparition de la fenêtre avec la liste de fichier filtrée avec les arguments envoyés par les sub de testsest importante ou pas
voir même cela vous gène t il plus que ça (que la fenêtre dos apparaisse brièvement (pour la fildialoSpecial1) )?

merci aux testeurs ;)
après moult tests dans diverses situations la version 5 et celle qui a été retenu
 

Pièces jointes

  • boite de dialog recherche de fichier V1 2 3 4 5 6.xlsm
    151.1 KB · Affichages: 1
Dernière édition:
Solution
bon après moults test dans diverses conditions pour la boites de dialog ce sera la petite dernière que j'ai un peu montré dans la vidéo
c'est pas la plus rapide mais

1° version 1 la méthode cmd Dir--> stdout readall ayant un problème de formatage et affichant la fenêtre de cmd vous l'avez compris de toute façon c'est la première a avoir été abandonnée

2° Version 2 méthode cmd dir --> fichier temporaire est acceptable mais selon l'occupation du pc elle peut varier su simple à X 7 a peu prés et elle exige forcement que au moins la destination du fichier soit autorisée pas simple sur pc pro voir même privé logué avec compte MS sur windows

3° version 3 FSO elle fonctionne très bien mais elle est plus lente que les autres mais je...

patricktoulon

XLDnaute Barbatruc
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;)
 

jurassic pork

XLDnaute Occasionnel
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;)
Hello patrick,
c'est la version 5 que tu as modifiée? En mettant des Dir$ à la place des Dir dans le module de cette version, c'est effectivement plus rapide au premier lancement.
Pour tous les fichiers de mon répertoire D:\Dev (environ 8000 fichiers) avec des Dir j'ai 400 ms au premier lancement puis 105 ms , avec des Dir$ j'ai 105 ms dès le premier lancement.
Ami calmant, J.P
 

patricktoulon

XLDnaute Barbatruc
Bonjour @jurassic pork
oui c'est bien la 5
tu n'es pas obligé de mettre dir$ a tous
comme je l'ai fait tu cloture et ouvre une mémoire pour dir en mettant tout simplement itemVu=dir$ avant la ligne itemVu=dir(dossier, vbdirectory)

mais si tu veux met le à tous ;)
franchement on est dans des temps records que j'ai jamais vu nul part avec le dir de vba
comme quoi MS ne nous dit pas tout il faut trouver avec des astuces
pour info le stamper sur cle usb 1. 0 et 2.0 sur port 3.0 est diminué aussi

c'est gagnant gagnant 😁
bon ben c'est bien tu me confirme que ca fonctionne sur une autre exploit et config
merci pour le retour

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
 

patricktoulon

XLDnaute Barbatruc
oui c'est vrai excuses chez moi
tout 3200 fichiers 57 ms
recherche typées 11 fichiers trouvés 65 ms

on l'a jamais vu ça à pourcentage = de puissance en terme de pc
le dir dans une fonction méthode classique que l'on trouve partout met 2.27 sec pour la même chose

même ma old dir est plus rapide qu'une fonction dir en recursive méthode classique
mais la 5 dirpilelist ,elle ben elle pétarde de feu de dieu
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
je joins le fichier avec les différents fonctions +test benchmark incorporé
 

Pièces jointes

  • Copie de new methode listing file intra recursive.xlsm
    180.1 KB · Affichages: 5

Nicolas JACQUIN

XLDnaute Impliqué
Supporter XLD
Bonjour Patrick,
je suis la discussion depuis un moment aussi, oui, voici ce que donne ton module "Methode0_5_Old_DIR_Recall"
je l'ai lancé 3 fois de suite.

VB:
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

Avec ta version précédente le 1, 2, 3, 4, j'avais des erreurs, ça plantait
 

patricktoulon

XLDnaute Barbatruc
bonsoir laurent
34 sec c'est quoi ,tu a listé les serveurs de la nasa ou quoi 😂

tu es le seul a me dire que le reste plante mais connaissant ta version pipée de excel ça m’étonne qu'a moitié
on a la versio avec api basé sur le code de laurent que j'ai un peu remanier a ma sauce qui va assez vite aussi
 

patricktoulon

XLDnaute Barbatruc
Bonsoir
jeannette la négative 😂🤪🤪🥳 wouhhhh!!!

je ne sais pas si le compte est juste mais en tout cas je pense qu'il représente quand même l'intérêt
du travail qu'a représenté cette recherche d'optimisation d'une fonction vba(DIr) bien souvent décriée et délaissée pour FSO certes plus facile à utiliser mais bien plus lourd
quoi que FSo aussi est déjà passé a ma moulinette
 

patricktoulon

XLDnaute Barbatruc
Bonjour à tous
aujourd'hui c'est la méthode 6 avec les api que l'on optimise
je passe en dessous la barre des 30 ms pour + de 2600 fichiers
a remplacer dans le dialog 6
VB:
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
 

Membres actuellement en ligne

Statistiques des forums

Discussions
315 087
Messages
2 116 084
Membres
112 655
dernier inscrit
fannycordi