Récupération du nom évolutif d’un répertoire (VBS)

Version imprimable

15/12/2016, 08h53
MrBiduleX

Récupération du nom évolutif d’un répertoire (VBS)

Bonjour à tous,

Je souhaiterais, en VBS, récupérer le nom d’un répertoire de la forme « C:\Machin\Truc\Exemple* » où le joker est une variable. Ce répertoire est unique mais son nom évolue.
L’équivalent en VBA serait MonRepertoire = Dir (« C:\Machin\Truc\Exemple* », vbDirectory).

Merci

Salut

En VBS, avec FileSystemObject il n'y a pas possibilité de filtrer les noms de dossiers.
Par contre tu peux utiliser ta commande DOS.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Dim Commande, MsG, RecupLg, RecupCl, T, WshShell, oFso, f
Const ForReading = 1
 
Set WshShell = CreateObject("WScript.Shell")
Commande = " /c Dir c:\p* > c:\Frecup.txt" ' /c Exécute la commande donnée par la chaîne de caractères puis se termine.
WshShell.Run "cmd.exe" & Commande, vbHide
Set WshShell = NotHing
WScript.Sleep 100
 
Set oFso = CreateObject("Scripting.FileSystemObject")
Set f = oFso.OpenTextFile("c:\Frecup.txt", ForReading)
MsG = f.ReadAll
f.Close
oFso.DeleteFile "c:\Frecup.txt",True  ' Le paramétre "Force" à true permet d'effacer les fichiers en lectures seules.
Set oFso = NotHing
 
RecupLg = Split(MsG, vbCrLf)
MsG = ""
For T = 0 To UBound(RecupLg) - 1
	RecupCl = Split(RecupLg(T), "<REP>", -1, vbTextCompare)
	If UBound(RecupCl) >= 1 Then MsG = MsG & vbCrLf & Trim(RecupCl(1))
Next
If MsG <> "" Then
    MsgBox MsG, vbInformation, "Ok"
    Else
    MsgBox "Pas de repertoire de trouvé", vbCritical, "Ko"
End If

Dans l'exemple, la variable MsG contient tous les répertoires commençant par P

16/12/2016, 08h55
MrBiduleX

Bonjour,
C'est très bien même si c'est plus long que "MonRepertoire = Dir (« C:\Machin\Truc\Exemple* », vbDirectory)" !!! :P
Bonne journée

Peut-être aussi une solution(quoique marqué résolu) qui ne nécessite pas de passage par des fichiers et par la commande DOS et qui offre la possibilité d'ouvrir le dossier cherché :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Option Explicit 
 
Const DossierOrigine = "C:\Machin\Truc\", DebutNom = "Exemple" 
Dim fso,  oFold, oSubFolder, Found, DossierTrouve
Found = False
Set fso = CreateObject("Scripting.FileSystemObject") 
Set oFold = fso.GetFolder(DossierOrigine)
For Each oSubFolder In oFold.SubFolders
    If LCase(Mid(oSubFolder.Name, 1, Len(DebutNom))) = LCase(DebutNom) Then
       MsgBox "Un dossier portant le nom : " & oSubFolder.Name & " a été trouvé."
       Found = True ' indicateur à utiliser si on veut ouvrir le dossier
       DossierTrouve = oSubFolder.Name
       Exit For ' inopérant si le dossier est unique
    End If
Next
' Si on veut ouvrir le dossier recherché, on peut faire :
If Found Then
    Dim WS
    Set WS = CreateObject("Wscript.Shell") 
    WS.Run "Explorer.exe " & DossierOrigine & DossierTrouve, 1, False
Else
       MsgBox "Aucun dossier correspondant à la demande !"
 
End If

19/12/2016, 12h01
MrBiduleX

Bonjour,
Oui, cette solution me parait plus élégante et mieux adaptée à mes besoins.
Merci à vous 2... :)
19/12/2016, 15h07
l_autodidacte

Citation:

Envoyé par MrBiduleX

Bonjour,
Oui, cette solution me parait plus élégante et mieux adaptée à mes besoins.
Merci à vous 2... :)

Sans pour autant dévaloriser celle de ProgElecT que je salue au passage.