Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Autres tester ma pseudo boite de dialogue fichier avec filtre

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
 

Pièces jointes

  • boite de dialog recherche de fichier with part of name and or extension.xlsm
    44.5 KB · Affichages: 19

Staple1600

XLDnaute Barbatruc
je vais attendre les retours de @Staple1600 pour valider cette solution comme finale
Franchement maintenant je ne pourrait pas vous dire la quelle est la plus rapide
Bonsoir le fil,
Suis de retour, mais ca va pas te plaire
Je ne sais pas si c'est plus rapide mais je m'amuse avec VBA+PowerShell (avec Export en CSV)
En tout cas, ca prend moins de place dans le projet VBA
Ci-dessous la ligne de commande PS (pour les curieux)
"Get-ChildItem XXXX -Recurse | Select-Object FullName,CreationTime,LastWriteTime|Export-Csv YYY\liste.csv -NotypeInformation"
PS: XXX= 1 folder et YYY un autre folder, on l'aura compris.
Je m'arrête là car c'est pas le sujet
(Surtout que je cherche aussi à interfacer Windows Search+VBA, je rappelle avoir vu des fils à ce sujet sur XLD)

Pour revenir à ton projet, maintenant que j'ai trouvé pourquoi ca ne marchait pas sur mon PC, j'ai un peu laché le fil de discussion
 

patricktoulon

XLDnaute Barbatruc
re moi aussi avec chatGPT j'ai monté une macrocro pilotant powershell
dans ta ligne de code il faut aussi supprimer le hearder de table ect pour n'avoir que les noms

malheureusement sur excel 32 c'est deux fois plus long ce n'est donc pas pour moi une solution
pour le fichier dans un sous dossier des downloads il met 4 seconde contre 0.019 pour le cmd dir

je peut te pdfifier la discussion sur chatGPT si tu veux
non ce n'est définitivement pas une solution pouvant être en concurence avec le dir de cmd
 

Staple1600

XLDnaute Barbatruc
Re

@patricktoulon
[aparté]
Où ai-je écris que j'avais utilisé ou que j'utilise ChatGPT ???
On voit que tu ne pratiques pas le Staple depuis longtemps !
Je suis sans doute le seul XLDNaute qui navigue sur XLD avec javascript désactivé, qui fait tout pour ne pas utiliser G..gle, etc...
Bref, si je me complexifie l'usage du net, Oui, je sais c'est vain c'est pas pour aller utiliser une IA (et nourrir la bête)
(D'autant plus qu'à terme, elles dépeupleront les forums comme XLD)
Pour l'instant, j'en suis à la génération du CSV directement depuis PS
(et cette partie là est rapide, non ?)
Et je trouve pas de pouvoir faire un oneliner ou presque
[/aparté]

Et la piste Windows Search ?
Code:
Private Sub mWS(strPath$)
Call Shell("explorer.exe " & Chr(34) & "search-ms:query=*.xlsx&crumb=location:" & strPath & Chr(34), vbNormalFocus)
End Sub
Sub test()
mWS "C:\Users\STAPLE\Documents\EXCEL"
End Sub
Ensuite, on peut Enregistrer la recherche mais pour récupérer cela dans un fichier texte ou dans Excel c'est une autre paire de manche, non ?
EDITION: J'ai continué à la mimine
CTRL+A puis Copier le chemin d'accès -> CTRL+V dans Excel
J'ai alors ma liste de fichiers dans Excel mais à part avec des SendKeys et ce genre de choses, je ne vois pas comment utiliser entièrement en VBA WindowsSearch pour générer ton temp_output.txt
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
version1 on voit la fenêtre de powershell
VB:
Sub testx()
    Dim chemin As String
    Dim mesfichiers As Collection
    chemin = "K:\vba excel"
    Set mesfichiers = SearchFiles(chemin)
    For Each fil In mesfichiers
        Cells(Rows.Count, 1).End(xlUp).Offset(1) = fil
    Next
End Sub

Function SearchFiles(strPath As String) As Collection
    Dim objShell As Object
    Dim objExec As Object
    Dim result As String
    Dim output As New Collection

    ' Commande PowerShell pour rechercher des fichiers .xlsx dans un dossier
    Dim cmd As String
    cmd = "powershell.exe -Command ""Get-ChildItem -Path '" & strPath & "' -Filter *.xlsx -Recurse | ForEach-Object { $_.FullName }"""

    ' Exécuter la commande PowerShell
    Set objShell = CreateObject("WScript.Shell")
    Set objExec = objShell.Exec(cmd) 'fenêtre powershel visible

    ' Lire les résultats ligne par ligne
    Do While Not objExec.StdOut.AtEndOfStream
        result = objExec.StdOut.ReadLine
        output.Add result
    Loop

    Set SearchFiles = output
End Function

version 2 on voit la fenêtre dos
VB:
Sub testy()
    Dim chemin As String
    Dim mesfichiers As Collection
    chemin = "K:\vba excel"
    Set mesfichiers = SearchFiles2(chemin)
    For Each fil In mesfichiers
        Cells(Rows.Count, 1).End(xlUp).Offset(1) = fil
    Next
End Sub

Function SearchFiles2(strPath As String) As Collection
    Dim objShell As Object
    Dim objExec As Object
    Dim result As String
    Dim output As New Collection

    ' Commande PowerShell pour rechercher des fichiers .xlsx dans un dossier
    Dim cmd As String
    cmd = "cmd.exe /c powershell -Command ""Get-ChildItem -Path '" & strPath & "' -Filter *.xlsx -Recurse | ForEach-Object { $_.FullName }"""

    ' Exécuter la commande PowerShell via cmd.exe en mode masqué
    Set objShell = CreateObject("WScript.Shell")
    Set objExec = objShell.Exec(cmd)

    ' Lire les résultats ligne par ligne
    Do While Not objExec.StdOut.AtEndOfStream
        result = objExec.StdOut.ReadLine
        output.Add result
    Loop

    Set SearchFiles2 = output
End Function

version 3 on est sensé ne voir aucune fenêtre mais chez moi je vois la fenêtre dos
VB:
Sub testz()
    Dim chemin As String
    Dim mesfichiers As Collection
    chemin = "K:\vba excel"
    Set mesfichiers = SearchFiles3(chemin)
    For Each fil In mesfichiers
        Cells(Rows.Count, 1).End(xlUp).Offset(1) = fil
    Next
End Sub

Function SearchFiles3(strPath As String) As Collection
    Dim objShell As Object
    Dim objExec As Object
    Dim result As String
    Dim output As New Collection

    ' Commande PowerShell pour rechercher des fichiers .xlsx dans un dossier
    Dim cmd As String
    cmd = "powershell -Command ""Get-ChildItem -Path '" & strPath & "' -Filter *.xlsx -Recurse | ForEach-Object { $_.FullName }"""
    
    ' Exécuter la commande PowerShell en mode totalement masqué
    Set objShell = CreateObject("WScript.Shell")
    Set objExec = objShell.Exec("cmd /c " & cmd)

    ' Lire les résultats ligne par ligne
    Do While Not objExec.StdOut.AtEndOfStream
        result = objExec.StdOut.ReadLine
        output.Add result
    Loop

    Set SearchFiles3 = output
End Function
 

Staple1600

XLDnaute Barbatruc
Re

@patricktoulon
malheureusement sur excel 32 c'est deux fois plus long ce n'est donc pas pour moi une solution
pour le fichier dans un sous dossier des downloads il met 4 seconde contre 0.019 pour le cmd dir
Je pensais que tu ne gardais que les méthodes précédentes et que donc tu ne poursuivais pas la piste PS.

Sinon pour WindowsSearch, tu penses que c'est possible?
Car le résultat de la recherche est stockée dans quoi ?
EDITION: Je viens de creuser un peu comment fonctionne WindowsSearch
Apparemment piste à oublier ici.
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
ben je suis parti sur des cript cmd/powershel divers mi apart le filtre que je n'arrive pas a coder j'ai un truc rapide sans que les fen^tre dos ou pS soit visible
tiens si tu sais faire moi je suis un oisillons avec ps
il te faut modifier le like et extension a ton besoins ainsi que le chemin dossier bien evidemment
VB:
#If VBA7 Then
    Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
                              ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, _
                              ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#Else
    Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
                              ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
                              ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If

Sub test9()
    Dim chemin As String
    Dim mesfichiers As Collection
    chemin = "K:\vba excel"
    Set mesfichiers = SearchFiles9(chemin)
    For Each fil In mesfichiers
        Cells(Rows.Count, 1).End(xlUp).Offset(1) = fil
    Next
End Sub

Function SearchFiles9(strPath As String) As Collection
    Dim output As New Collection
    Dim tempFile As String
    Dim result As String
    Dim stream As Object

    ' Chemin du fichier temporaire pour capturer les résultats
    tempFile = Environ("TEMP") & "\fileList.txt"

    ' Commande PowerShell pour rechercher des fichiers .xlsx
    Dim cmd As String
    'cmd = "powershell -Command ""Get-ChildItem -Path '" & strPath & "' -Filter *.xlsx -Recurse | ForEach-Object { $_.FullName } | Set-Content -Path '" & tempFile & "' -Encoding utf8"""
   cmd = "powershell -Command ""Get-ChildItem -Path '" & strPath & "' -Recurse | Where-Object { $_.Name -like '*cdo*' -and $_.Extension -eq '.xls*' } | ForEach-Object { $_.FullName } | Set-Content -Path '" & tempFile & "' -Encoding utf8"""

    ' Exécuter PowerShell via ShellExecute pour éviter l'affichage de fenêtres
    ShellExecute 0, "open", "cmd.exe", "/c " & cmd, vbNullString, 0

    ' Attendre que le fichier temporaire soit créé
    Do While Dir(tempFile) = ""
        DoEvents
    Loop

    ' Utiliser ADODB.Stream pour lire le fichier
    Set stream = CreateObject("ADODB.Stream")
    With stream
        .Type = 2 ' Type de flux : texte
        .Charset = "utf-8" ' Définir l'encodage
        .Open
        .LoadFromFile tempFile ' Charger le fichier dans le flux

        ' Lire les lignes du fichier et les ajouter à la collection
        Do While Not .EOS
            result = .ReadText(-2) ' Lire une ligne
            output.Add result
        Loop

        .Close
    End With

    ' Supprimer le fichier temporaire
    Kill tempFile

    ' Retourner la collection
    Set SearchFiles9 = output
End Function
 

Staple1600

XLDnaute Barbatruc
Re

@patricktoulon
patricktoulon à dit:
il te faut modifier le like et extension a ton besoins ainsi que le chemin dossier bien evidemment
Moi, je n'ai aucun besoin
Au départ, j'ai mis ma panoplie d'utilisateur maladroit d'Excel pour tester ton classeur
Y a eu un os (qu'on mit du temps à trouver )
Puis j'ai digressé vers PS puis maintenant WS
Au final, je crois que maintenant j'ai besoin d'aller au dodo

Et la réflexion , selon les configurations avec PS, il y aura surement des surprises, donc je pense que tes précédentes méthodes sont plus sures.

Bonne nuit.

PS: Pour PS, je l'utilise avec des scripts *.ps1
Là, c'était juste pour le fun, je cherchais les autres méthodes encore possibles, et non présentes dans ton classeur pour lister des fichiers.
Je crois qu'en parlant de PS et WS, on a fait le tour.
Je ne vois pas d'autres méthodes possibles
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
oui surtout que les méthodes 1,2 et 3 sont au pont maintenant
moi je n'arrive pas à fermer l'oeuil quand il y a quelque chose qui me turlupine comme ça
le fichier final se trouve en post #90
c’était le oem850/Ansi/utf-8 qui me bombardait le mou

maintenant c'est chose réglé avec la petite fonction de @jurassic pork OemToChar utilisant l'api du même nom
 

jurassic pork

XLDnaute Occasionnel
Hello,
j'ai fait des essais avec la version du post #90, cela m'a l'air correct. Dans le code il manque les Dim pour les fdlr, la fonction oem2ansi peut être viré.
J'ai aussi codé une quatrième version avec du Powershell mais en utilisant ceci :
VB:
Public Function PS_GetOutput(ByVal sPSCmd As String) As String
    Dim tempFile As String, i As Long, x As Long
    'Setup the powershell command properly
    tempFile = Environ("userprofile") & "\desktop\temp_output.txt"
    sPSCmd = "powershell -command & {" & sPSCmd & _
             "}  2>&1 | Out-File -Encoding default -FilePath " & tempFile
    'Execute the command
    CreateObject("WScript.Shell").Run sPSCmd, 0, True
    Do While Dir(tempFile) = "" Or i = 2000: i = i + 1: DoEvents: Loop
    x = FreeFile: Open tempFile For Input As #x: PS_GetOutput = Input$(LOF(1), x): Close #x
    If Dir(tempFile) <> "" Then Kill tempFile
End Function

Function Recherche_PowerShell(chemin, partOfString, Recursive) As String
Dim Resultat As String, WhereToSearch As String, WhatToSearch As String
WhereToSearch = chemin: WhatToSearch = partOfString
If Recursive Then
   Resultat = PS_GetOutput("Get-ChildItem " & WhatToSearch & " -Path " & WhereToSearch & _
                          " -Force -Recurse | Select-Object -ExpandProperty FullName ")
Else
   Resultat = PS_GetOutput("Get-ChildItem " & WhatToSearch & " -Path " & WhereToSearch & _
                          " | Select-Object -ExPandProperty FullName ")
End If
Recherche_PowerShell = Resultat
End Function
Sub TestRecherchePS()
 Debug.Print Recherche_PowerShell("D:\Dev", "***.xlsm", True)
End Sub

Function Recherche_PowerShell2(chemin, partOfString, Recursive) As String
Dim Resultat As String, WhereToSearch As String, WhatToSearch As String
Dim Pwsh As Object
Set Pwsh = CreatePowerShellClass()
WhereToSearch = chemin: WhatToSearch = partOfString
If Recursive Then
  Resultat = Pwsh.ExecuteCmd("Get-ChildItem '" & WhatToSearch & "' -Path '" & WhereToSearch & _
                          "' -Recurse | Select-Object -ExpandProperty FullName| Out-String")
Else
   Resultat = Pwsh.ExecuteCmd("Get-ChildItem '" & WhatToSearch & "' -Path '" & WhereToSearch & _
                          "' | Select-Object -ExPandProperty FullName | Out-String")
End If
Recherche_PowerShell2 = Resultat
End Function
patricktoulon , j'ai repris ton principe de fichier temporaire mais il y a une ligne que je ne comprend pas :
VB:
Do While Dir(tempFile) = "" Or i < 2000: i = i + 1: DoEvents: Loop
A quoi sert i ?
Le fichier temporaire est généré en ANSI grâce à -Encoding default
Recherche_PowerShell2
Utilise une dll externe qui mélange du C et du Csharp pour accèder à PowerShell plus rapidement que par le Shell.
Voici les performances pour les différentes versions :
Recherche de *.xlsm résultats 165 fichiers
Recherche V1 0,97 s
Recherche V2 481 ms
Recherche V3 239 ms
Recherche V4 111 ms (Recherche_PowerShell2 PowerShell par l'intermédiaire d'une dll unmanaged Csharp)
Recherche V4 1 1,12 s (Recherche_PowerShell PowerShell lancé par un WScript.Shell)



Ami calmant, J.P
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
Bonjour @jurassic pork
i sert a sortir quand même au bout d'un moment si c'est trop long

test effectué
VB:
Sub TestRecherchePS()
 Debug.Print Recherche_PowerShell("k:\vba excel", "*test*.xls*", True)
End Sub
resultat


test 2 effectué
VB:
Sub TestRecherchePS()
 Debug.Print Recherche_PowerShell("k:\", "*test*.xls*", True)
End Sub
résultat
 

jurassic pork

XLDnaute Occasionnel
Pour le problème du test 1 tu peux essayer ceci :
VB:
Function Recherche_PowerShell(chemin, partOfString, Recursive) As String
Dim Resultat As String, WhereToSearch As String, WhatToSearch As String
WhereToSearch = chemin: WhatToSearch = partOfString
If Recursive Then
   Resultat = PS_GetOutput("Get-ChildItem '" & WhatToSearch & "' -Path '" & WhereToSearch & _
                          "'  -Recurse | Select-Object -ExpandProperty FullName ")
Else
   Resultat = PS_GetOutput("Get-ChildItem " & WhatToSearch & " -Path '" & WhereToSearch & _
                          "' | Select-Object -ExPandProperty FullName ")
End If
Recherche_PowerShell = Resultat
End Function
je met des simples quotes autour de WhatToSearch et WhereToSearch dans le cas où il y a des blancs dans ces variables mais ce qui me paraît bizarre c'est qu'on voit un % entre Vba et Excel dans ton message.

i sert a sortir quand même au bout d'un moment si c'est trop long
C'est bizarre ton code car au lieu de i = 2000 , cela devrait être i < 2000 et pourquoi 2000 ? il n'y a pas de tempo (comme un sleep) dans la boucle.

Edit : je viens d'enlever aussi l'option -Force car cela peut poser problème quand le chemin n'est pas trouvé. Cela sert pour récupérer aussi les fichiers cachés.
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
tu a raison c'est pas "=" mais "<" pour i
des fois je recode à toute vitesse sans regarder
je teste ta new mouture
edit:testé
là oui elle fonctionne
mais on est loin derrière toute les autres
celles que j'ai fait hier avec api shellexecute sont plus rapide

VB:
Public Function PS_GetOutput(ByVal sPSCmd As String) As String
    Dim tempFile As String, i As Long, x As Long
    'Setup the powershell command properly
    tempFile = Environ("userprofile") & "\desktop\temp_output.txt"
    sPSCmd = "powershell -command & {" & sPSCmd & _
              "} 2>&1 | Out-File -Encoding default -FilePath " & tempFile
    'Execute the command
    CreateObject("WScript.Shell").Run sPSCmd, 0, True
    Do While Dir(tempFile) = "" Or i = 2000: i = i + 1: DoEvents: Loop
    x = FreeFile: Open tempFile For Input As #x: PS_GetOutput = Input$(LOF(1), x): Close #x
    If Dir(tempFile) <> "" Then Kill tempFile
End Function



Function Recherche_PowerShell(chemin, partOfString, Recursive) As String
    Dim Resultat As String, WhereToSearch As String, WhatToSearch As String
    WhereToSearch = chemin: WhatToSearch = partOfString
    If Recursive Then
        Resultat = PS_GetOutput("Get-ChildItem '" & WhatToSearch & "' -Path '" & WhereToSearch & _
                                 "' -Force -Recurse | Select-Object -ExpandProperty FullName ")
    Else
        Resultat = PS_GetOutput("Get-ChildItem " & WhatToSearch & " -Path '" & WhereToSearch & _
                                 "' | Select-Object -ExPandProperty FullName ")
    End If
    Recherche_PowerShell = Resultat
End Function


Sub TestRecherchePS()
    Dim x$, tim#
    tim = Timer
    x = Recherche_PowerShell("k:\vba excel", "***.xlsm", True)
    MsgBox "k:\vba excel\*.xlsm" & vbCrLf & _
            "recherche effectuée en " & Format(Timer - tim, "#0.000 "" Secondes"" pour " & UBound(Split(x, vbCrLf)) & " fichier(s)")
    Debug.Print x

End Sub
 

jurassic pork

XLDnaute Occasionnel
oui c'est normal le lancement du powershell par le shell est lent. Par contre regarde mes tests de performance plus haut si j'attaque directement le powershell par une dll c'est le plus rapide.
As-tu vu qu'Il faut aussi enlever l'option -Force. Quand il y a cette option si le chemin n'est pas trouvé, il attaque des chemins interdits :
 
Dernière édition:
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…