Boite de dialogue pour choisir un Répertoire

Contenu du snippet

'Clés pour  BrowseAndCreate
Public Enum ctConfigBrowse
    PrtButtonOkCancel = -273
    PrtButtonOkCancelInfo = -17
    PrtButtonOkCancelTextbox = -1
    ButtonCreateOKCancel = 0
    ButtonCreateOKCancelTextBox = 16
    ButtonCreateOKCancelInfo = 256
    ButtonOkCancel = 512
    ButtonOkCancelTextbox = 528
End Enum
'Clés pour BrowseAndCreate
Public Enum ctConfigDir
    DirExplorer = 1 'Interdit
    DirProgrammeUser
    DirPanneauDeConfiguration
    DirImprimantesEtTelecopieurs
    DirMesDocuments
    DirFavorisUser
    DirDemarrageUser
    DirDocumentsRecents
    DirSendTo
    DirCorbeille
    DirMenuDemarrer
    DirBureau
    DirMaMusique
    DirMesVideosUser
    DirPosteDeTravail = 17
    DirFavorisReseau
    DirVoisinReseau
    DirFonts
    DirModelesUser
    DirMenuDemarrerPrgramme
    DirProgrammeAllUser
    DirDemarrageAllUser
    DirApplicationDataUser = 26
    DirVoisinageImpression
    DirLocalSettingsApplicationData
    DirFavorisAllUser = 31
    DirTemporaryInternetFilesUser
    DirCookiesUser
    DirHistoriqueUser
    DirApplicationDataAllUser
    DirWindows
    DirWindowsSystem32
    DirProgramFiles
    DirMesImagesUser
    DirUser
    DirFichiersCommuns = 43
    DirModeleAllUser = 45
    DirDocumentsPartages
    DirOutilsAdministrationAllUser
    DirOutilsAdministrationUser
    DirConnexionReseau
    DirMaMusiqueAllUser = 53
    DirMesImagesAllUser
    DirMesVideosAllUser
    DirRessources
    DirResources040c
    DirCDBurning = 59
End Enum

Function BrowseAndCreate(hWnd As Long, Optional Title As String = "Rechercher...", _
    Optional ConfigBox As ctConfigBrowse =  ButtonCreateOKCancelTextBox, _
    Optional ByVal ConfigDir As ctConfigDir = DirPosteDeTravail)  As String
    
'    CHOIX  REPERTOIRE
    Dim Shell As Variant, Folder As Variant
    Set Shell = CreateObject("Shell.Application")
    
    On Error Resume Next
    Set Folder = Shell.BrowseForFolder(hWnd, Title, ConfigBox,  CInt(ConfigDir))
    BrowseAndCreate = Folder.items.Item.Path
    
    If LenB(BrowseAndCreate) = 0 Then
        BrowseAndCreate = vbNullString
    ElseIf LeftB$(BrowseAndCreate, 4) = "::" Then
        BrowseAndCreate = vbNullString
    Else
        If Not (RightB$(BrowseAndCreate, 2) = "\") Then BrowseAndCreate = BrowseAndCreate & "\"
    End If
    
    Set Folder = Nothing
    Set Shell = Nothing
End Function


Compatibilité : VB6, VBA

Disponible dans d'autres langages :

A voir également

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.