--- Soumis par Dev Ashish--
BrowseFolder Dialog
(Q) Ok, je sais comment utiliser la fonction API " GetOpenFileName", mais je ne suis intéressé qu'aux répertoires.Comment puis-je faire, à partir du code?
(A) Couper-coller le code suivant dans un nouveau module.
'************** Code Start ************** 'Ce code fut originalement écrit par Terry Kreft. 'Il ne doit être ni altéré, ni distribué 'sauf comme partie intégrée à une application. 'Vous êtes libre d'utiliser ce code 'à la condition de laisser cette note, sans modification. ' 'Code courtesy of 'Terry Kreft Private Type BROWSEINFO hOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpfn As Long lParam As Long iImage As Long End Type Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _ "SHGetPathFromIDListA" (ByVal pidl As Long, _ ByVal pszPath As String) As Long Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _ "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _ As Long Private Const BIF_RETURNONLYFSDIRS = &H1 Public Function BrowseFolder(szDialogTitle As String) As String Dim X As Long, bi As BROWSEINFO, dwIList As Long Dim szPath As String, wPos As Integer With bi .hOwner = hWndAccessApp .lpszTitle = szDialogTitle .ulFlags = BIF_RETURNONLYFSDIRS End With dwIList = SHBrowseForFolder(bi) szPath = Space$(512) X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath) If X Then wPos = InStr(szPath, Chr(0)) BrowseFolder = Left$(szPath, wPos - 1) Else BrowseFolder = "" End If End Function '*********** Code End *****************
Sauvegarder le module sous un nom qui ne soit pas celui d'une fonction. Inspirez vous de l'exemple ci-dessous pour appeler cette fonction.
Dim strFolderName as string
strFolderName = BrowseFolder("Quel répertoire désirez-vous utiliser?")