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

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

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

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

#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

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

Do While Dir(tempFile) = "" Or i < 2000: i = i + 1: DoEvents: Loop

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

Sub TestRecherchePS()
 Debug.Print Recherche_PowerShell("k:\", "*test*.xls*", True)
End Sub

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

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