Cette API permet d’ouvrir la boite de dialogue système de Windows permettant à l’utilisateur de sélectionner un répertoire.
La variable lpbi permet de paramétrer l’affichage de cette boite de dialogue comme par exemple le titre et le libellé de celle-ci.
Référence : MSDN
Exemple VB/VBA :
L’exemple suivant pour VB/VBA implémente cette API et permet de sélectionner un répertoire :
Option Explicit
'----------------------------------------
'------Déclarations propres aux API------
'----------------------------------------
'---Les constantes---
Private Const BIF_RETURNONLYFSDIRS As Long = 1
Private Const BIF_DONTGOBELOWDOMAIN As Long = 2
'---Les API---
Private Declare Function SHBrowseForFolder Lib "shell32.dll" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32.dll" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
'---Les types---
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
'----------------------------------------------------------------------------------------------
'------Procédure permettant de sélectionner un répertoire par l'ouverture d'une boite ------
'------de dialogue système ------
'----------------------------------------------------------------------------------------------
Private Function SelectionneRepertoire(sTitre As String, Handle As Long) As String
'---Déclaration des variables---
Dim lpIDList As Long
Dim sBuffer As String
Dim lpbi As BrowseInfo
'---Initialisation des paramètres de la boite de dialogue---
With lpbi
.hWndOwner = Handle
.lpszTitle = lstrcat(sTitre, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With
'---Ouvre la boite de dialogue---
lpIDList = SHBrowseForFolder(lpbi)
'---Retour---
If (lpIDList) Then
sBuffer = String(260, vbNullChar)
SHGetPathFromIDList lpIDList, sBuffer
SelectionneRepertoire = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
Else
SelectionneRepertoire = ""
End If
End Function
'--------------------------------------
'------Procédures évènementielles------
'--------------------------------------
Private Sub Command1_Click()
'---Selectionne un répertoire---
Text1.Text = SelectionneRepertoire("Sélectionnez un répertoire :", Me.hWnd)
End Sub
'----------------------------------------
'------Déclarations propres aux API------
'----------------------------------------
'---Les constantes---
Private Const BIF_RETURNONLYFSDIRS As Long = 1
Private Const BIF_DONTGOBELOWDOMAIN As Long = 2
'---Les API---
Private Declare Function SHBrowseForFolder Lib "shell32.dll" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32.dll" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
'---Les types---
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
'----------------------------------------------------------------------------------------------
'------Procédure permettant de sélectionner un répertoire par l'ouverture d'une boite ------
'------de dialogue système ------
'----------------------------------------------------------------------------------------------
Private Function SelectionneRepertoire(sTitre As String, Handle As Long) As String
'---Déclaration des variables---
Dim lpIDList As Long
Dim sBuffer As String
Dim lpbi As BrowseInfo
'---Initialisation des paramètres de la boite de dialogue---
With lpbi
.hWndOwner = Handle
.lpszTitle = lstrcat(sTitre, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With
'---Ouvre la boite de dialogue---
lpIDList = SHBrowseForFolder(lpbi)
'---Retour---
If (lpIDList) Then
sBuffer = String(260, vbNullChar)
SHGetPathFromIDList lpIDList, sBuffer
SelectionneRepertoire = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
Else
SelectionneRepertoire = ""
End If
End Function
'--------------------------------------
'------Procédures évènementielles------
'--------------------------------------
Private Sub Command1_Click()
'---Selectionne un répertoire---
Text1.Text = SelectionneRepertoire("Sélectionnez un répertoire :", Me.hWnd)
End Sub