Author: Gilles ROY
Browse Folders Dialog
This code allows you to dispay the Browse Folders dialog with one simple function call. The function returns the name of the selected folder, or an empty string if cancel was pressed.
Paste the below code straight into a BAS module, or download the BAS file from the below link.
'############################################################################### '# $FICHIER : BrowseFolders.bas '# $VERSION : v1.0 '# '# HISTORI/UE DES MODIFICATIONS/ '# v1.0 OD 14/05/1999 Criation '############################################################################### option Explicit 'Constantes private Const BIF_RETURNONLYFSDIRS = &H1 'Uniquement des ripertoire private Const BIF_DONTGOBELOWDOMAIN = &H2 'Domaine globale intredit private Const BIF_STATUSTEXT = &H4 'Zone de saisie autorisie private Const BIF_RETURNFSANCESTORS = &H8 private Const BIF_EDITBOX = &H10 'Zone de saisie autorisie private Const BIF_VALIDATE = &H20 'insist on valid result (or CANCEL) private Const BIF_BROWSEFORCOMPUTER = &H1000 'Uniquement des PCs. private Const BIF_BROWSEFORPRINTER = &H2000 'Uniquement des imprimantes private Const BIF_BROWSEINCLUDEFILES = &H4000 'Browsing for Everything private Const MAX_PATH = 260 'Types private Type T_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 'Fonctions API Windows private Declare Function SHBrowseForFolder Lib "shell32" _ (lpbi as T_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 '************************************************************* '* BrowseFolder : '* Entries : - HwndOwner : Handle de la fenjtre appelante '* - Titre : Titre '* Sorties : '* - string contenant le chemin complet ou Chaine vide '* (si annulation) '* '* Affiche une boite de dialogue permettant la silection d'un ripertoire. '* Renvoie une chaine vide si l'opirateur annule. '************************************************************* public Function BrowseFolder(byval HwndOwner as Long, _ byref Titre as string) as string Dim lpIDList as Long Dim sBuffer as string Dim BrowseInfo as T_BROWSEINFO 'Initialise l'affichage BrowseFolder = "" With BrowseInfo .HwndOwner = HwndOwner .lpszTitle = lstrcat(Titre, "") .ulFlags = BIF_RETURNONLYFSDIRS End With 'Affiche la boite de dialogue lpIDList = SHBrowseForFolder(BrowseInfo) 'Ricuphre le ripertoire silectionni If (lpIDList) then sBuffer = Space(MAX_PATH) SHGetPathFromIDList lpIDList, sBuffer sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1) BrowseFolder = sBuffer End If End Function