Discussion :

[nawax88]

Bonjour,

Je souhaite (si cela est possible ) afficher la fenêtre parcourir qui renvoie un fichier (utilisation de commonDialog) mais par contre je voudrais qu'elle renvoie un répertoire, comment faire?

Merci d'avance pour vos réponses

[Phifi]

Bonjour,

l'objet CommonDialog ne renvoie pas de répertoire, tu dois passer par une API :

http://vb.developpez.com/faq/?page=Fichiers#select_rep

[OhMonBato]

Y'a aussi le controle DirListBox tout bête...

[nawax88]

En fait mon problème est que le client souhaite une fenêtre Parcourir mais veut sélectionner un dossier et pas un fichier. J'avais déja vu cette solution mais elle ne correspond pas aux attentes donc je ne sais pas.

Si jamais vous avez d'autre solution

[Phifi]

Gni ? je parle français ou bien ?

Tu as 2 solutions toutes cuites. En quoi elle ne correspondent pas à tes attentes ?

[nawax88]

en fait c'était pour conserver l'interface que je demandais, sinon ces 2 solutions je les avais trouvé.
J'ai regardé la tienne SelectFolder, mais je n'ai pas trouver comment paramétrer le chemin accés à l'ouverture de boite de dialogue, il y a un moyen?

[ThierryAIM]

avec ça c'est possible :

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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
 
Private Const BIF_STATUSTEXT As Long = &H4&
Public Const BIF_RETURNONLYFSDIRS As Long = &H1
Public Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Public Const BIF_RETURNFSANCESTORS As Long = &H8
Public Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Public Const BIF_BROWSEFORPRINTER As Long = &H2000
Public Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Public Const BIF_NONEWFOLDERBUTTON As Long = &H200
Public Const BIF_NEWDIALOGSTYLE As Long = &H40
Public Const BIF_UAHINT As Long = &H100
Public Const BIF_EDITBOX As Long = &H10
 
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
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 Const BFFM_INITIALIZED As Long = 1
Private Const BFFM_SELCHANGED As Long = 2
Private Const BFFM_SETSTATUSTEXT As Long = (WM_USER + 100)
Private Const BFFM_SETSELECTION As Long = (WM_USER + 102)
 
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
Private m_strDirectory As String
 
 
Public Function SelectFolder(Titre As String, Handle As Long, _
                             Optional uFlags As Long = BIF_RETURNONLYFSDIRS, _
                             Optional ByVal StartDir As String) As String
 
Dim lpIDList As Long
Dim strBuffer As String
Dim strTitre As String
Dim tBrowseInfo As BROWSEINFO
 
    m_strDirectory = StartDir & vbNullChar
 
    strTitre = Titre
    With tBrowseInfo
        .hwndOwner = Handle
        .lpszTitle = lstrcat(strTitre, "")
        .ulFlags = uFlags + BIF_NEWDIALOGSTYLE + BIF_NONEWFOLDERBUTTON '+ BIF_DONTGOBELOWDOMAIN
 
        .lpfnCallback = GetAddressOfFunction(AddressOf BrowseCallbackProc)
    End With
 
    lpIDList = SHBrowseForFolder(tBrowseInfo)
 
    If (lpIDList) Then
        strBuffer = String(MAX_PATH, vbNullChar)
        SHGetPathFromIDList lpIDList, strBuffer
        CoTaskMemFree lpIDList
        SelectFolder = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
    Else
        SelectFolder = vbNullString
    End If
 
End Function
 
Private Function BrowseCallbackProc(ByVal hwnd As Long, ByVal uMessage As Long, ByVal lpIDList As Long, _
                                    ByVal pData As Long) As Long
 
Dim lngRet As Long
Dim strBuffer As String
 
    On Error Resume Next
    Select Case uMessage
    Case BFFM_INITIALIZED
        Call SendMessage(hwnd, BFFM_SETSELECTION, 1, m_strDirectory)
    Case BFFM_SELCHANGED
        strBuffer = Space(MAX_PATH)
        lngRet = SHGetPathFromIDList(lpIDList, strBuffer)
        If lngRet = 1 Then
            Call SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, strBuffer)
        End If
    End Select
    BrowseCallbackProc = 0
End Function
 
Public Function GetAddressOfFunction(P As Long) As Long
    GetAddressOfFunction = P
End Function

Edit: rajout des décarations complètes