Option Explicit
Sub testDIRcmd()
Dim Racine$, tim#, T
'Racine = "H:\*.txt"
Racine = "H:\"
[A1].CurrentRegion.Clear
tim = Timer
T = ListFichierCmdDos(Racine)
MsgBox Timer - tim & " seconde(s) pour " & UBound(T) & " fichier ou dossiers(s)"
[A1].Resize(UBound(T), 1).Value = T
End Sub
Function ListFichierCmdDos(Racine$, Optional dossier& = 2)
Dim laChaine$, x&, fichier$, bat$, Commande$, tim#, tbl, tblV, i&, arr1, arr2, a&, doss
doss = Switch(dossier = 0, "/A:-D", dossier = 1, "/A:D", dossier = 2, "")
arr1 = Array("a`", "a^", "a¨", "e`", "e^", "e¨", "i`", "i^", "i¨", "o`", "o^", "o¨", "u`", "u^", "u¨") 'array caracteres séparés
arr2 = Array("à", "â", "ä", "è", "ê", "ë", "ì", "î", "ï", "ò", "ô", "ö", "ù", "û", "ü") 'array caracteres regroupés
bat = "C:\Users\polux\Desktop\baton.cmd"
fichier = Environ("userprofile") & "\Desktop\list.txt"
Commande = "chcp 28591 > nul " & vbCrLf & "dir " & Racine & " /S /B /O " & doss & " >" & fichier
'creation du bath
x = FreeFile: Open bat For Output As #x: Print #x, Commande: Close #x
ShellAndwaitingEndProcess bat 'appel fonction shell améliorée
'lecture du fichier
x = FreeFile: Open fichier For Binary Access Read As #x: laChaine = String(LOF(x), " "): Get #x, , laChaine: Close #x
For a = 0 To UBound(arr1) 'on fait le replace dans la chaine globale si defaut present(plus rapide que le replace dans les ligne du tableau)
If laChaine Like "*" & arr1(a) & "*" Then laChaine = Replace(laChaine, arr1(a), arr2(a))
Next
tbl = Split(laChaine, vbCrLf) 'coupe(array 1 dim)
'convert array 1 dim to 2 dim(transpose)
ReDim tblV(UBound(tbl), 1 To 1): For i = 0 To UBound(tbl): tblV(i, 1) = tbl(i): Next
ListFichierCmdDos = tblV
Kill bat
Kill fichier
End Function
Function ShellAndwaitingEndProcess(ByVal CheminComplet As String) As Long
Dim ProcessHandle As Long
Dim ProcessId As Long
'ProcessId = Shell(CheminComplet, vbNormalFocus)
ProcessId = Shell(CheminComplet, vbHide)
'ON PASSE AUX APIS PAYée AU BLACK SANS DECLARATION
ProcessHandle = ExecuteExcel4Macro("CALL(""Kernel32"",""OpenProcess"",""JJJJ"",""" & 2031616 & """,""" & 0 & """,""" & ProcessId & """)")
ShellAndwaitingEndProcess = ExecuteExcel4Macro("CALL(""Kernel32"",""WaitForSingleObject"",""JJJJJ"",""" & ProcessHandle & """,""" & &HF0000 & """)")
End Function
