Selection de répertoire : valeur par défaut + bouton "créer"

[Tententai]

Bonjour,

Dans une appli j'ouvre une fenêtre qui permet à l'utilisateur de choisir un répertoire. Il y a un répertoire racine, et un répertoire sélectionné par défaut.

Pour cela j'utilise ce code (source : Tofalu sur ce forum)

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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
 
Option Compare Database
 
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const BFFM_INITIALIZED = 1
Private Const WM_USER = &H400
Private Const BFFM_SETSELECTIONA = (WM_USER + 102)
 
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, _
    ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, _
    ByVal lpString2 As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                              (ByVal hWnd As Long, ByVal wMsg As Long, _
                              ByVal wParam As Long, lParam As Any) As Long
 
Private Declare Function SHGetIDListFromPath Lib "SHELL32.DLL" Alias "#162" (ByVal szPath As String) As Long
 
Private Type BrowseInfo
    hWndOwner As Long
    pIDLRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
     ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
End Type
 
Function adr(n As Long) As Long
adr = n
End Function
 
Public Function BrowseCallbackProc(ByVal hWnd As Long, _
                                                      ByVal uMsg As Long, _
                                                      ByVal lParam As Long, _
                                                      ByVal lpData As Long) As Long
  If uMsg = BFFM_INITIALIZED Then
      Call SendMessage(hWnd, BFFM_SETSELECTIONA, False, ByVal lpData)
  End If
End Function
 
Public Function SelectFolder(Title As String, Handle As Long, DefaultFolder As String) As String
 
Dim lpIDList As Long
Dim strBuffer As String
Dim strTitle As String
Dim tBrowseInfo As BrowseInfo
 
 
strTitle = Title
 
With tBrowseInfo
    .hWndOwner = Handle
    .lpszTitle = lstrcat(strTitle, "")
    .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN 
    .lpfnCallback = adr(AddressOf BrowseCallbackProc)
    .lParam = SHGetIDListFromPath(StrConv(DefaultFolder, vbUnicode))
    .pIDLRoot = SHGetIDListFromPath(StrConv("C:\", vbUnicode))
End With
 
lpIDList = SHBrowseForFolder(tBrowseInfo)
 
If (lpIDList) Then
    strBuffer = String(260, vbNullChar)
    SHGetPathFromIDList lpIDList, strBuffer
    SelectFolder = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
End If
 
End Function

Ca fonctionne bien, mais quand j'essaye de rajouter un bouton de création de répertoire, avec ce code (source : Arkham46 sur ce forum aussi) ...

Code :

1
2
3
4
5
6
 
Private Const BIF_NEWDIALOGSTYLE As Long = &H40
 
...
 
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN + BIF_NEWDIALOGSTYLE

Le bouton est bien créé, le répertoire racine ("C:\") est toujours bon, mais le répertoire par défaut n'est plus selectionné.

Quelqu'un sait pourquoi ?
Merci pour votre aide.

[Dolphy35]

Salut,

Si tu veux ton répertoire par défaut enlève cette ligne :

Code :

.pIDLRoot = SHGetIDListFromPath(StrConv("C:\", vbUnicode))

Dolphy

[Tententai]

Salut,

Merci pour la suggestion, mais quand j'enlève cette ligne, je n'ai pas de répertoire par défaut quand même

Grosso modo, j'aimerais avoir trois choses en même temps :
- une racine pour mon arborescence (pIDLRoot)
- un répertoire qui sera sélectionné par défaut (lParam)
- un bouton de création de répertoires

Et les résultats suivants :

Racine + Répertoire par défaut : OK
Racine + Bouton de création : OK
Racine + Répertoire par défaut + Bouton de création : je n'ai que le bouton et la racine
Répertoire par défaut + Bouton de création : je n'ai que le bouton

Apparament, à partir du moment ou je rajoute ce bouton, le répertoire par défaut n'est plus pris en compte.

Je pige pas

[Dolphy35]

re,

effectivement je n'avais pas bien compris ton souhait

en passant le répertoire dans le DefaultFolder, cela fonctionne et en ne mettant pas pIDLRoot mais tu as toute l'arborescence des disques. Tu ne veux que le disque sélectionné dans pIDLRoot qui s'affiche dans la fenêtre ?

Code :

MsgBox SelectFolder("test", Me.hWnd, "D:\Mes documents")

Dolphy

[Tententai]

Oui en effet j'ai besoin de limiter l'arbre à un disque, les utilisateurs n'ayant pas le droit de toucher au reste.

En fait, l'idéal serait même de restreindre le tout à un seul répertoire (celui que je voulais prendre par défaut), et ainsi juste utiliser pIDLRoot. Mais quand j'essaie de passer "C:\essai" au lieu de "C:\" à pIDLRoot, la fonction SHBrowseForFolder me renvoie "Folder C:\essai cannot be used. Please select another folder."

Cette API est bien mystérieuse pour moi

[arnaudTHE]

Bonjour à tous,

Je déterre un peu (beaucoup?) le sujet...
Cela fait quelques jours que je n'arrive pas à régler cette question de "lParam"...
Le tutoriel de SilkyRoad a été utilisé (merci à lui!) comme référence.
La fenetre de recherche fonctionne parfaitement, mais je souhaiterais "pré-définir" un dossier lors de son ouverture.
Seulement, je n'arrive pas du tout à régler le "lParam"...
L'erreur d'execution 13 s'affiche : incompatibilité de type.

Mon code plante à cette ligne précise :

Code :

1
2
3
4
5
With tBrowseInfo
    .lpszTitle = lstrcat(szTitle, "")
    .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
    .lParam = SHGetPathFromIDList(StrConv(szPath, vbUnicode), "")
End With

La fonction SHGetPathFromIDList est définie comme suite :

Code :

Private Declare Function SHGetPathFromIDList Lib "SHELL32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Si vous avez des idées n'hésitez pas à faire signe!