sélectionner un dossier en VBA

Version imprimable

11/11/2009, 20h01
Daejung

sélectionner un dossier en VBA

Bonjour,

J'utilise le code trouvé ici http://www.cathyastuce.com/index.php...cles&topics=87 pour sélectionner un dossier en VBA

Cela marche parfaitement, sauf quand je sélectionne la racine "MonNomDeUser", alors que cela devrait me ramener C:\Users\MonNomDeUser

Comment récupérer le chemin dans tous les cas, dont celui-ci?

Merci
11/11/2009, 21h02
ucfoutu

Bonjour,
Mis à part le fait que je ne pense pas devoir être invité à ouvrir un lien (de surcroît vers un autre site) pour savoir de quoi il s'agit !!! :

je ne comprends pas ton expression ici :

Citation:

sauf quand je sélectionne la racine "MonNomDeUser"

Tel qu'écrit , tu parles d'une chaîne de caractères et dans ce cas ??? ..... ===>>
- (un simple msgbox devrait te montrer le résultat !)

et ce que tu écris là :

Citation:

alors que cela devrait me ramener C:\Users\MonNomDeUser

ne veut strioctement rien dire si tu ne nous dis pas ce que tu obtiens et dénonces !!! :ccool:

A tout hasard, donc :
1) intéresse-toi à la fonction ENVIRON (ton aide en ligne)
2) dis-nous ce que tu veux, de manière claire, pour que l'on puisse non moins clairement t'indiquer le paramètre attendu.
11/11/2009, 21h40
Jean-Philippe André

Bonsoir,
serait-il possible d'être un peu plus explicite sur l'objectif visé stp ?
Le lien que tu fournis n'est pas suffisant pour ma part quant à la compréhension de ton énoncé.

Que souhaites-tu afficher ou attribuer à tes variables stp ?

Bricolé

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
28
29
30
Option Explicit
Public Function ChoixDossierFichier(SelType As Byte) As String
Dim objShell As Object, objFolder As Object
Dim Chemin As String, Msg As String
Dim FlagChoix As Long, NbPoint As Integer
 
If SelType = 0 Then
    FlagChoix = &H1
    Msg = "Sélectionner un dossier :"
Else
    FlagChoix = &H4000
    Msg = "Sélectionner un fichier :"
End If
 
Set objShell = CreateObject("Shell.Application")
On Error Resume Next
Set objFolder = objShell.BrowseForFolder(&H0&, Msg, FlagChoix)
NbPoint = InStr(objFolder.Title, ":")
 
If NbPoint = 0 Then
    If IsError(objFolder.ParentFolder.ParseName(objFolder.Title).Path) Then
        Chemin = "C:\Users\" & objFolder.Title
    Else
        Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
    End If
Else
    Chemin = Mid(objFolder.Title, NbPoint - 1, 2)
End If
ChoixDossierFichier = Chemin
End Function

Edit: Pour ton cas particulier

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Public Function ChoixDossier() As String
Dim objShell As Object, objFolder As Object
 
Set objShell = CreateObject("Shell.Application")
On Error Resume Next
Set objFolder = objShell.BrowseForFolder(&H0&, "Sélectionner un dossier :", &H1)
 
If IsError(objFolder.ParentFolder.ParseName(objFolder.Title).Path) Then
    ChoixDossier = "C:\Users\" & objFolder.Title
Else
    ChoixDossier = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
End If
End Function