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 Declare Sub CoTaskMemFree Lib
"ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" (ByVal lpString1 As
String, ByVal lpString2 As String) 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
Public Function ChoixDossier(Titre)
Dim Rien As Integer
Dim Liste As Long
Dim Resultat As String
Dim Browse_info As BrowseInfo
With Browse_info
.lpszTitle = lstrcat(Titre, "")
.ulFlags = 1
End With
Liste = SHBrowseForFolder(Browse_info)
If Liste Then
Resultat = String$(260, 0)
SHGetPathFromIDList Liste, Resultat
CoTaskMemFree Liste
Rien = InStr(Resultat, vbNullChar)
If Rien Then
ChoixDossier = Left$(Resultat, Rien - 1)
End If
End If
End Function
Sub Test()
MsgBox ChoixDossier("Choissez le dossier machin")
End Sub