Cette source se trouve sur le site VBFrance, mais j'ai eu la flemme d'aller la rechercher, je l'ai reprise d'un de mes programmes.
En tous cas, elle n'est pas de moi, mais qu'est ce qu'elle est pratique ! :op
=======CODE SOURCE===============
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 BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260
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
Public Function GetDirectory(stTitre As String) As String
' Cette fonction permet de récupérer un chemin de répertoire.
Dim stTmp As String
Dim biStruct As BrowseInfo
Dim lgRep As Long
' On passe le handle de la fenêtre appellante
' (ici on suppose que c'est la fenêtre courante).
biStruct.hWndOwner = Me.hWnd
' On utilise lstrcat pour récupérer un pointeur sur une chaîne.
biStruct.lpszTitle = lstrcat(stTitre, vbNullString)
biStruct.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
' Affichage de la fenêtre de sélection.
lgRep = SHBrowseForFolder(biStruct)
If lgRep Then
stTmp = Space$(MAX_PATH)
' On récupère le répertoire choisit.
SHGetPathFromIDList lgRep, stTmp
stTmp = Left$(stTmp, InStr(stTmp, vbNullChar) - 1)
Else
stTmp = vbNullString
End If
' Retourne la valeur (ou un chaîne vide en cas d'erreur).
GetDirectory = stTmp
End Function
====================
APPEL DE LA FONCTION
====================
Private Sub Command1_Click()
Dim path As String
path = GetDirectory("Choisissez un répertoire")
msgbox "Répertoire sélectionné : " & path
End Sub
Manu
|