Sub RechercherDossier()
Rem. —— Déclaration de constante et de variables.
Const Racine = "D:\Test\" '"C:\Documents and Settings\luck\Mes documents\" '
Dim XNom As String, TDos() As String, Nbr As Long, TMsg() As String, N As Long
Rem. —— Saisie du nom désiré.
XNom = InputBox("Quel client recherchez vous", "Nom")
If XNom = "" Then Exit Sub ' Abandon si aucune réponse fournie.
Rem. —— Recherche du 1er nom, puis boucle sur les suivants.
XNom = Dir(Racine & "*" & XNom & "*", vbDirectory)
Do While XNom <> "" ' Tant que le nom rendu par Dir n'est pas vide :
If (GetAttr(Racine & XNom) And vbDirectory) = vbDirectory Then ' S'il s'agit bien d'un répertoire :
Nbr = Nbr + 1: ReDim Preserve TDos(1 To Nbr): TDos(Nbr) = XNom: End If ' … on l'ajoute dans la table
XNom = Dir: Loop ' Nom suivant
Rem. —— Test selon le nombre de noms trouvés
If Nbr > 1 Then ' S'il y en a plus d'un :
ReDim TMsg(0 To Nbr): TMsg(0) = "Lequel voulez vous ? (1 à " & Nbr & ")" ' On fabrique un tableau avec un élément 0 devant,
For N = 1 To Nbr: TMsg(N) = N & ": """ & TDos(N) & """": Next N ' … et qui reprend ceux du 1er précédés de leurs numéros
N = 0: On Error Resume Next: N = InputBox(Join(TMsg, vbLf), "Nom", 1): On Error GoTo 0 ' On saisit le numéro désiré.
If N < 1 Or N > Nbr Then Exit Sub ' Abandon si aucune réponse valide fournie.
ElseIf Nbr = 1 Then ' S'il y en a exactement 1 :
N = 1 ' On se met dans le même cas que s'il avait été répondu 1 à une saisie du numéro.
Else ' Si donc il n'en exste aucun :
MsgBox "Le client n'existe pas.", vbCritical, "Nom" ' on le dit …
Exit Sub: End If ' … et on abandonne la procédure.
Rem. —— Épilogue : exécution de l'exploreur
'Shell "C:windowsexplorer.exe " & Racine & TDos(N), vbMaximizedFocus ' Ne fonctionne pas chez moi.
Shell "C:\WINDOWS\explorer.exe " & Racine & TDos(N), vbMaximizedFocus
End Sub