Discussion :

[Tententai]

Bonjour,

Je voudrais ouvrir une fenêtre qui permet à l'utilisateur de sélectionner un répertoire, avec un répertoire donné qui sera la racine. Pour cela j'ai trouvé ce code dans la FAQ :

http://access.developpez.com/faq/?pa...Rep#select_rep

Ca marche bien, mais je n'arrive pas à définir une racine. Je suppose qu'il faut passer par la propriété pIDLRoot, mais c'est un long. Comment je transforme le chemin de mon répertoire racine en pIDLRoot ?

Merci d'avance pour vos conseils.

[cafeine]

Hello,

tu trouveras ton bonheur par là >>> http://argyronet.developpez.com/offi...iaporama/#L3-2

[Tofalu]

Bonjour,

Pour obtenir l'IDList d'un répertoire, il faut utiliser SHGetIDListFromPath.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Private Declare Function SHGetIDListFromPath _
Lib "SHELL32.DLL" Alias "#162" (ByVal szPath As String) As Long

Attention le path doit être en unicode.


Le paramètre pIDLRoot correspond à la racine de l'explorateur. Il sera impossible de choisir un répertoire parent dans ce cas.


Ce qui donne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Public Function SelectFolder(Titre As String, Handle As Long, Racine As String) As String
 
Dim lpIDList As Long
Dim strBuffer As String
Dim strTitre As String
Dim tBrowseInfo As BrowseInfo
 
strTitre = Titre
With tBrowseInfo
    .pIDLRoot = SHGetIDListFromPath(StrConv(Racine, vbUnicode))
    .hWndOwner = Handle
    .lpszTitle = lstrcat(strTitre, "")
    .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
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

En revanche, pour présélectionner un répertoire, c'est le paramètre lParam qui doit recevoir l'IDList. C'est plus compliqué car il faut faire appel à une fonction de rappel.

Le module devient :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
  'Quand la boite est ouverte actualise le chemin présélectionné
      Call SendMessage(hWnd, BFFM_SETSELECTIONA, False, ByVal lpData)
  End If
End Function
 
 
 
Public Function SelectFolder(Titre As String, Handle As Long, Racine As String) As String
 
Dim lpIDList As Long
Dim strBuffer As String
Dim strTitre As String
Dim tBrowseInfo As BrowseInfo
 
 
 
strTitre = Titre
With tBrowseInfo
    .hWndOwner = Handle
    .lpszTitle = lstrcat(strTitre, "")
    .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
    .lpfnCallback = adr(AddressOf BrowseCallbackProc)
    .lParam = SHGetIDListFromPath(StrConv(Racine, 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

Exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Sub test()
MsgBox SelectFolder("Hello", 0, "D:\essai")
End Sub

[Tofalu]

Hello,

tu trouveras ton bonheur par là >>> http://argyronet.developpez.com/offi...iaporama/#L3-2

Avec cette solution et la mienne, on a vraiment un truc complet sur ce coup là

Alllez hop, sources

[Tententai]

Nickel, merci