Sélècteur de Répertoire

[Michael DELIQUE]

Code : Tout sélectionner

Option Public
Option Declare


'variable API pour la fonction GetDirectory_API
Type BROWSERINFO
   nbOwner As Long
   nbRoot As Long
   nbDisplayName As String
   BITitle As String
   nbFlag As Long
   nblpfn As Long
   nbParam As Long
   nbImage As Long
End Type

Const BIF_RETURNONLYFSDIRS = 1
Const MAX_SIZE = 255

Declare Function GetActiveWindow Lib "user32.dll" () As Long
Declare Function BrowseFolderDlg Lib "shell32.dll" Alias "SHBrowseForFolder" (lpBrowseInfo As BROWSERINFO) As Long
Declare Function GetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDList" (Byval nbPointer As Long, Byval PathBuffer As String) As Long

Code : Tout sélectionner

Function GetDirectory_API(wnbRepertoire As Long) As String
   'Cette Fonction permet de faire la sélection d'un répertoire
   
   'Déclaration des Variables   
   Dim InfoNavigation As BROWSERINFO
   Dim nbPointer As Long
   Dim nbResult As Long
   Dim PathBuffer As String
   Dim PathRepertoire As String
   
   On Error Goto ErreurGetDirectory_API
   
   InfoNavigation.nbOwner = GetActiveWindow()
   
   ' Répertoire par défaut
   Select Case wnbRepertoire
   Case 0 'Poste de Travail
      InfoNavigation.nbRoot = 0
   Case 5 'Mes Documents
      InfoNavigation.nbRoot = 5
   Case Else
      InfoNavigation.nbRoot = 0
   End Select
   
   InfoNavigation.BITitle = "Sélectionnez le répertoire : "
   InfoNavigation.nbDisplayName = String(MAX_SIZE, Chr(0))
   InfoNavigation.nbFlag = BIF_RETURNONLYFSDIRS
   
   nbPointer = BrowseFolderDlg(InfoNavigation)
   
   If nbPointer <> 0 Then
      PathBuffer = String(MAX_SIZE, Chr(0))
      nbResult = GetPathFromIDList(Byval nbPointer, Byval PathBuffer)
      PathRepertoire = Left(PathBuffer, Instr(PathBuffer, Chr(0)) - 1)
   End If
   
   GetDirectory_API = PathRepertoire
   
   Exit Function
ErreurGetDirectory_API:
   Msgbox "(GetDirectory_API) Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   GetDirectory_API = ""
   Exit Function
End Function