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

Sub test2()
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    ' Exemple : Créer un fichier texte dans le dossier Documents
    Dim file As Object
    Set file = fso.CreateTextFile("C:\TonDossier\example.txt", True)
    file.WriteLine "Hello World!"
    file.Close
End Sub

Sub TestRun()

    Dim shell As Object
    Set shell = CreateObject("WScript.Shell")
 
    ' Exécute un programme (ex : notepad.exe)
    shell.Run "notepad.exe"

End Sub

Sub TestFileSystemObject()

    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
 
    ' Créer un fichier texte dans le répertoire Documents
    Dim file As Object
    Set file = fso.CreateTextFile("C:\Users\TonNomUtilisateur\Documents\example.txt", True)
    file.WriteLine "Hello World!"
    file.Close

End Sub

Sub TestA()
CreateObject("WScript.Shell").Run "winver.exe"
End Sub
Sub testB()
Dim strPath
strPath = ThisWorkbook.Path & "\"
With CreateObject("Scripting.FileSystemObject").CreateTextFile(strPath & "test.txt")
    .WriteLine Date
    .WriteLine Time
    .Close
End With
End Sub

Function recherche_récursive3(dparent, Optional partname As String = "*.*", Optional Recurr As Boolean = False, Optional L As String) As Variant
    Dim FSO As Object, Lparent As Object, SubFolder As Object, Ficher As Object, A As Boolean, B As Boolean
    Static first As Boolean
    Set FSO = CreateObject("scripting.filesystemobject")

    If Not TypeOf dparent Is Object  Then
        Set Lparent = FSO.GetFolder(dparent)
        first = True
    Else
        Set Lparent = dparent
    End If
    If GetAttr(Lparent) <> 22 Then
        Dim done As Boolean
        On Error Resume Next
        done = Len(Dir(Lparent.Path & "\" & partname)) > 0
        On Error GoTo 0
        If done Then
            For Each Ficher In Lparent.Files
                If LCase(Ficher.Name) Like partname Then L = L & Ficher.Path & vbCrLf
            Next
        End If

        If Recurr Then
            For Each SubFolder In Lparent.SubFolders
                recherche_récursive3 SubFolder.Path, partname, Recurr, L
            Next SubFolder
        End If
    End If
    If first Then recherche_récursive3 = L
End Function

Public Sub go_Click()
tempFile = Environ("userprofile") & "\desktop\temp_output.txt"
ListBox1.Clear
chemin = TxtbFolder ' Le folder dans le textbox
If chemin = "" Then MsgBox "test1": Exit Sub
If Right(chemin, 1) <> "\" Then chemin = chemin & "\" ' On prévoit le séparateur si nécessaire
If TxtbExpression <> "" Then Expression = "*" & TxtbExpression ' Expression dans la partie du nom
If Checkrecursif Then Recurr = " /S" ' Commande récursive si le checkbox est true
    If TxtbExtension <> "" Then
        If TxtbExtension Like "[!A-Za-z0-9]*" Then MsgBox "Extension non valide": Exit Sub
        Extension = "*." & TxtbExtension
        Else: Extension = "*.*"
    End If
    ' Concat de la ligne de commande
    Dim TempString As String
    TempString = Replace("cmd /C Dir ""*****""" & Recurr & " /b /a-d > """ & tempFile & """", "*****", CStr(chemin) & Expression & "*." & Extension, 1, -1, vbTextCompare)
    Debug.Print TempString ' Contrôle dans la console
    ' La variable Liste récupère le texte du stdout
    CreateObject("Wscript.Shell").Run TempString, 0, True ' 0 = cacher la fenêtre, True = attendre que la commande se termine
    Do While Dir(tempFile) = "" Or i = 2000
    i = i + 1
    DoEvents
    Loop
    x = FreeFile
    Open tempFile For Input As #x
    Liste = Input$(LOF(1), x)
    Close #x
If Liste = "" Then MsgBox "test2": Exit Sub
End Sub