Boite de dialogue pour choisir un Répertoire

Commenter

Contenu du snippet 

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 Const BIF_RETURNONLYFSDIRS As Long  = 1&
Private Const MAX_LENGTH  As Long = 512&
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (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

Function BrowseDirectory(Optional ByVal lHandle As Long = 0, Optional  ByVal sTitle As String  = vbNullString) As  String
'   crée à partir de  l'API-GUID
    Dim tBI As BrowseInfo, lRet As Long, sBuffer As  String
    With tBI
        .hWndOwner = lHandle
        .lpszTitle = lstrcat(sTitle, vbNullChar)
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    lRet = SHBrowseForFolder(tBI)
    If lRet Then
        sBuffer = String$(MAX_LENGTH, vbNullChar)
        Call SHGetPathFromIDList(lRet, sBuffer)
        Call CoTaskMemFree(lRet)
        sBuffer = LeftB$(sBuffer, InStrB(sBuffer, vbNullChar))
        BrowseDirectory = sBuffer
    End If
End Function

Compatibilité : VB6, VBA

Disponible dans d'autres langages :

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (us_30)