Paradigmes 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
' 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
' 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
Commentaires
Aucune inscription n'est requise si vous souhaitez
Rechercher sur le site
  |  RSS |  Informations |