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

Microsoft 365 Liste des fichiers dans le répertoire

R

RollyLCXL

XLDnaute Nouveau
Bonjour,

J'utilise le code sn = Split(CreateObject("wscript.shell").exec("cmd /c dir """ & F & """ /a:-d /b").StdOut.ReadAll, vbCrLf)

Et j'envoi la liste des fichiers du répertoire courant dans une feuille Excel avec le code ... .Resize(UBound(sn) + 1) = Application.Transpose(sn).

Tout se fait parfaitement sauf ceci. Des caractères sont remplacés. Par exemple un fichier nommé Nouveautés.pdf dans le répertoire est renommé Nouveaut,s.pdf.

Il semble que tous les accents sont remplacés par des autres caractères étranges.

Comment faire afin d'obtenir le nom tel que dans l'Explorateurs de Fichiers de Windows?

C'est que cette façon de faire est extrêmement plus rapide qu'avec un Loop.

Merci à l'avance.
 
Trier par date Trier par votes

patricktoulon

XLDnaute Barbatruc
oui c'est énorme c'est l'effet de cache on l'a remarqué dans la discussion de ma pseudo boite
et c'est pareil avec la methode run du shell pareil avec adobd requête sur le windows filesearch
et aussi avec le Dir de VBA
 
Vote positif 0 Vote négatif

mapomme

XLDnaute Barbatruc
Supporter XLD
Re @patricktoulon, @jurassic pork ,

Je viens de refaire les tests avec le code de @jurassic pork et celui de ma pomme (un peu plus verbeux, il faut bien que je l'avoue ).

A chaque fois, j'ai redémarré ma bécane pour être certain d'avoir vidé le cache. J'ai rajouté un "/S" à la commande de @jurassic pork pour aussi lister les sous-répertoires (comme pour mapomme) :
VB: 
res = CreateObject("wscript.shell").exec("cmd /c chcp 1252 > nul  & cmd /c dir /s """ & F & """ /a:-d /b ").StdOut.ReadAll

Voici les résultats :


nota 1 : à la première exécution il ne semble pas y avoir d'effet de cache pour ma pomme (n'y aurait-il rien à cacher? ).

note 2 : après la première exécution, la durée des exécutions suivantes sont du même ordre de grandeur pour les deux méthodes.

Pour information, le code utilisé basée sur la version nippone de @jurassic pork :
VB: 
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
 
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
j'essaie d'adapter à le recherche selective mais ça passe pas
VB: 
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

par contre avec mon fichier temps oui
VB: 
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
 
Vote positif 0 Vote négatif

jurassic pork

XLDnaute Occasionnel
mapomme à dit:
Re @patricktoulon ,

Sur ma bécane :
  • Procédure testbyfiletemp fonctionne mais les accents sont incorrects
Cliquez pour agrandir...
Avec cette modif dans testbyfiletemp les accents sont corrects :
VB: 
'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

Mais l'astuce nipponne ne semble pas fonctionner chez patrick
Les 2 run consécutifs dans le with ne fonctionnent pas chez moi non plus ( mauvais accents)
 
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
re
si c'est bon ça fonctionne il faut faire attention au espaces en trop c'est tout
pour le coup la voila en petite fonction
j'ai essayé le utf-8 aussi c'est bon comme ça si il y a besoin
VB: 
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
 
Vote positif 0 Vote négatif
R

RollyLCXL

XLDnaute Nouveau
Bonjour,

Un ... énorme merci. Le code ci-dessous fonctionne parfaitement aussi chez moi et cela répond parfaitement au besoin.

Je suis vieux aussi ... Je ne croyais pas y arriver car j'avais fais beaucoup de recherche. Je suis impressionné. Vraiment encore merci à vous.

VB: 
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
 
Dernière modification par un modérateur:
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

C
  • Résolu(e)
XL 2021 Sauvegarder répertoire/sous répertoire un peu volumineux 2 Go
Réponses
7
Affichages
183
Claudinedu13
C
  • Résolu(e)
Autres Tests de diverses solution pour lister dans un dialog perso des fichiers en filtrant par expression et extension
10 11 12
Réponses
175
Affichages
16 K
patricktoulon
  • Question
XL 2021 Liste des propriétés de fichiers.
3 4 5
Réponses
73
Affichages
3 K
jeff1494
J
  • Question
Microsoft 365 macro qui ouvre des fichiers excel de type "analyze in excel" généré par power bi et met à jour un filtre "mois" sur plusieurs tcd
Réponses
0
Affichages
59
JJ69
J
I
  • Question
Microsoft 365 Renommer des fichiers avec des caractères non reconnus
Réponses
10
Affichages
797
ivan27
I
  • Résolu(e)
XL 2010 Problème màj feuilles depuis fichiers CSV
2
Réponses
23
Affichages
2 K
cathodique
T
  • Résolu(e)
XL 2010 VBA - Lister fichiers et décortiquer le nom des fichiers dans colonne A et B
Réponses
5
Affichages
434
sylvanu
  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
404
Chaton77
  • Résolu(e)
Microsoft 365 lister des fichiers
2
Réponses
19
Affichages
2 K
Usine à gaz
  • Question
XL 2016 Script pour copier fichiers dans un répertoire
Réponses
3
Affichages
462
gsx-air
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…