Utilitaires
Scripts
Divers
Jeux
Rechercher
Quillevere.net
Réflexions informatiques

Lister rapidement les sous-répertoires en VBS

12/12/2020

La commande getFolder en VBScript permet de lister les sous-répertoires d'un dossier. Cependant, s'il y a beaucoup de sous-répertoires ou sur des répertoires réseaux, cela peut être lent. Si vous souhaitez faire un filtre sur les sous-répertoires à lister, voici deux alternatives. La technique utilise la commande DIR du DOS pour renvoyer les sous-répertoires (format ANSI pour les caractères accentués).

Méthode 1 avec Exec

Cette méthode utilise Exec. L'inconvénient est qu'elle affiche, très rapidement certes, une fenêtre DOS.

' Renvoie les répertoires d'un dossier correspondant au filtre
' Ex : listeSousRepertoires("c:\windows", "system*")
function listeSousRepertoires(sRepertoireSrc, sFiltre)

    Dim arrList
    Set arrList = CreateObject("System.Collections.ArrayList")
   
    Dim objShell
    Set objShell = CreateObject("Wscript.Shell")

    dim sReponse
    dim oRet
    set oRet=objShell.exec("%comspec% /c ""chcp 1250 | dir /ad /b " & chr(34) & sRepertoireSrc & "\" & sFiltre & chr(34) & """")
    Do
        sReponse=oRet.StdOut.ReadLine()
        if sReponse<>"" then arrList.Add sRepertoireSrc & sReponse
 Loop While Not oRet.Stdout.atEndOfStream  
     
    Set listeSousRepertoires=arrList
end function

Méthode 2 avec Run

Cette autre méthode utilise un fichier temporaire et la méthode Run paramétrée pour masquer les fenêtres intempestives.

' Renvoie les répertoires d'un dossier correspondant au filtre
' Ex : listeSousRepertoires("c:\windows", "system*")
function listeSousRepertoires(sRepertoireSrc, sFiltreRepertoire)

    Dim listeRepertoires
   
    Dim objShell
    Set objShell = CreateObject("Wscript.Shell")

    dim sRepEtFiltre:   sRepEtFiltre=sRepertoireSrc
    if right(sRepEtFiltre,1)<> "\" then sRepEtFiltre=sRepEtFiltre & "\"
    sRepEtFiltre=sRepEtFiltre & sFiltreRepertoire

   
    dim sReponse
    sReponse=executeFichier("%comspec% /c ""chcp 1250 | dir /ad /b " & chr(34) & sRepEtFiltre & chr(34) & """")

    listeSousRepertoires=split(sReponse, vbCrlf)
end function

' Exécute un fichier et renvoie la sortie (utilisation d'un fichier temporaire
Function executeFichier(sFichierAvecParametres)

    Dim objShell
    Set objShell = CreateObject("Wscript.Shell")
   
    dim oFS
    Set oFS = CreateObject("Scripting.FileSystemObject")

    ' Attribue un fichier temporaire
    dim sFichierTmp
    sFichierTmp = objShell.ExpandEnvironmentStrings("%temp%") & oFS.GetTempName
   
    On Error Resume Next
    objShell.Run sFichierAvecParametres & " > " & sFichierTmp, 0, True

    If Err.Number = 0 Then
        executeFichier = oFS.OpenTextFile(sFichierTmp, 1).ReadAll
        oFS.DeleteFile sFichierTmp, True
    else
        executeFichier = ""
    End If

    On Error GoTo 0
End Function
Dernière modification le 12/12/2020 - Quillevere.net

Rechercher sur le site

fr en rss RSS info Informations