1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51
| 'Constantes permettant de personnaliser le fonctionnement de BrowseForFolder
Const BIF_RETURNONLYFSDIRS = &H1 'pour chercher les fichiers systèmes seulement
' si le dossier sélectionné ne contient pas
' de fichier système alors le bouton "OK" est grisé
Const BIF_DONTGOBELOWDOMAIN = &H2 'interdit d'explorer en dehors du domaine 'For starting the Find Computer
Const BIF_STATUSTEXT = &H4 '
Const BIF_RETURNFSANCESTORS = &H8 'seulement des dossiers
Const BIF_EDITBOX = &H10 'Affiche une zone d'édition
Const BIF_VALIDATE = &H20 'Vérifie la saisie dans la zone d'édition
Const BIF_BROWSEFORCOMPUTER = &H1000 'Autorise le parcours réseau
Const BIF_BROWSEFORPRINTER = &H2000 'mes documents et bureau uniquemnet
Const BIF_BROWSEINCLUDEFILES = &H4000 'dossiers et fichiers
Const BIF_NONEWFOLDERBUTTON = &H200 'ne pas mettre le bouton Nouveau dossier
'affiche la boite de dialogue Windows de recherche d'un dossier
Function ChoixDossierFichier(bDos As Boolean, Msg As String) As String
'bDos 0 sélection de fichier ; 1 sélection de dossier
'Msg Message affiché sur la boite
Dim objShell As Object, objFolder As Object
Dim Chemin As String
Dim FlagChoix As Long, NbPoint As Integer
If bDos Then
FlagChoix = BIF_RETURNFSANCESTORS
Else
FlagChoix = BIF_BROWSEINCLUDEFILES + BIF_NONEWFOLDERBUTTON
End If
Set objShell = CreateObject("Shell.Application")
' 1er paramètre toujours 0 (zéro). Il représente le handle de la fenêtre parent
' 2ème paramètre Titre de la boite, en dessous de la barre de titre
' 3ème paramètre options de BrowseForFolder
' 4ème paramètre Facultatif. Répertoire de début d'exploration
On Error Resume Next
Set objFolder = objShell.BrowseForFolder(&H0&, Msg, FlagChoix)
'Si l 'objet retourné est valide, on teste son contenu (item.title)
'Si on a sélectionné la racine d'une partition, il se compose du nom de la partition,
' suivi de sa lettre et ":" entre parenthèses
NbPoint = InStr(objFolder.Title, ":")
If NbPoint = 0 Then
'Sinon, il se compose du nom du dossier uniquement, sans le chemin précédent
'On récupère ce chemin à l'aide des propriété et méthode ParentFolder.ParseName
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
Else
' si racine on récupère la lettre du lecteur et les 2 points
Chemin = Mid(objFolder.Title, NbPoint - 1, 2)
End If
ChoixDossierFichier = Chemin
End Function |
Partager