Microsoft 365 Liste des fichiers dans le répertoire

res = CreateObject("wscript.shell").exec("cmd /c chcp 1252   && cmd /c dir """ & F & """ /a:-d /b").StdOut.ReadAll

res = CreateObject("wscript.shell").exec("cmd /c chcp 1252 > nul  & cmd /c dir /s """ & F & """ /a:-d /b ").StdOut.ReadAll

Sub TestDir()
Dim F, sn, res As String, deb
   deb = Timer
   F = "C:\Program Files"
   res = CreateObject("wscript.shell").exec("cmd /c chcp 1252 > nul  & cmd /c dir /s """ & F & """ /a:-d /b ").StdOut.ReadAll
   sn = Application.Transpose(Split(res, vbCrLf))
   [a1].EntireColumn.ClearContents
   [a1].Resize(UBound(sn) + 1) = sn
   MsgBox Format(Timer - deb, "#,##0.##\ sec.")
End Sub

Sub TestDir()
    Dim f$, sn, res As String, deb
    Dim tempFile$, TempString$, Expression$, Extension$, recurr$, Tim

    f = "k:\vba excel\" ' chemin à explorer

    Expression = "*cdo*" 'expression recherchée (on peut utiliser les jokers)

    Extension = "*.*" 'extension recherchée (on peut utiliser les jokers)

    'tempFile = ThisWorkbook.Path & "\output.txt" 'chemin du fichier temporaire


    recurr = " /S" ' récursivité

    TempString = " cmd /C dir """ & f & Expression & Extension & Chr(34) & recurr & " /a:-d /b "

    Debug.Print TempString
    deb = Timer

    f = "k:\vba excel"

    res = CreateObject("wscript.shell").exec("cmd /c chcp 1252 > nul " & TempString).StdOut.ReadAll

    sn = Application.Transpose(Split(res, vbCrLf))

    [a1].EntireColumn.ClearContents

    [a1].Resize(UBound(sn) + 1) = sn

    MsgBox Format(Timer - deb, "#,##0.##\ sec.")

End Sub

Sub testbyfiletemp()
    Dim Chemin$, tempFile$, TempString$, Expression$, Extension$, recurr$, Tim
    
    Chemin = "k:\vba excel\" ' chemin à explorer
    
    Expression = "*é*è*" 'expression recherchée (on peut utiliser les jokers)
    
    Extension = "*.*" 'extension recherchée (on peut utiliser les jokers)
    
    tempFile = ThisWorkbook.Path & "\output.txt" 'chemin du fichier temporaire
    
    recurr = " /S" ' récursivité
    
    'string de la commande
    TempString = "cmd /C Dir """ & CStr(Chemin) & Expression & Extension & Chr(34) & recurr & " /b /a-d > """ & tempFile & Chr(34)

Debug.Print TempString
      
       Tim = Timer
    ' La variable Liste récupère le texte du stdout
    With CreateObject("Wscript.Shell")
        .Run "cmd /C chcp 1252", 0 ', True ' change le format du Dos
        .Run TempString, 0, True ' 0 = cacher la fenêtre, True = attendre que la commande se termine
    End With
    
    Do While Dir(tempFile) = "": DoEvents: Loop

    x = FreeFile: Open tempFile For Input As #x: liste = Input$(LOF(1), x): Close #x
    
    Tim = Format(Timer - Tim, """ en ""#0.000 ""Sec""")
    
    MsgBox Tim & vbCrLf & liste

End Sub

TempString = " & cmd /C dir """ & f & Expression & Extension & Chr(34) & recurr & " /a:-d /b "

'string de la commande
    TempString = " & cmd /C Dir """ & CStr(Chemin) & Expression & Extension & Chr(34) & recurr & " /b /a-d > """ & tempFile & Chr(34)


Debug.Print TempString
    
       Tim = Timer
    ' La variable Liste récupère le texte du stdout
    With CreateObject("Wscript.Shell")
        .Run "cmd /C chcp 1252" & TempString, 0, True ' 0 = cacher la fenêtre, True = attendre que la commande se termine
    End With

Sub Test_Cmd_DIR()
    Dim Liste, tim

    [a1].EntireColumn.ClearContents

    tim = Timer
    Liste = CmdDirList("k:\vba excel\", "*cdo*", "*.xl*", True) '(1252 ou omis = normal / 65001 utf-8)
    tim = Format(Timer - tim, "#,##0.##\ sec.")

    [a1].Resize(UBound(Liste)) = Application.Transpose(Liste)

    MsgBox tim

End Sub

Function CmdDirList(lFolder$, _
                    Optional Expression As String = "*", _
                    Optional Extension As String = "*.*", _
                    Optional Recursif As Boolean = False, _
                    Optional TextFormat As Long = 1252)
    
    'CmdDirList V 2.7(StdOut.ReadAll)
    '@patricktoulon
    '@jurassic pork
    '@mapomme
    Dim sn, res$, CHCP&, TempString$, recurr$

    If Right(lFolder, 1) <> "\" Then lFolder = lFolder & "\"

    If Recursif Then recurr = " /S" ' récursivité

    TempString = "& cmd /C dir """ & lFolder & Expression & Extension & Chr(34) & recurr & " /a:-d /b "

    Debug.Print TempString

    res = CreateObject("wscript.shell").exec("cmd /c chcp " & TextFormat & " > nul " & TempString).StdOut.ReadAll

    If res <> "" Then

        CmdDirList = Split(res, vbCrLf)

        Else: res = Array("")

    End If
End Function

Private Declare PtrSafe Function OemToChar Lib "user32" Alias "OemToCharA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
Sub TestDir()
Dim F, sn, res As String
F = "d:\dev\office\excel"
res = CreateObject("wscript.shell").exec("cmd /c dir """ & F & """ /a:-d /b").StdOut.ReadAll
OemToChar res, res
sn = Split(res, vbCrLf)
End Sub