Selection de dossier avec bouton "nouveau dossier"

Description

Suite a une demande sur le forum (et oui, encore !!) , j'ai fais ce module.

Ca permet d'afficher l'assistant de selection de dossier (avec un bouton "Nouveau Dossier" )

Source / Exemple :


Private Sub Form_Load()
    MsgBox BrowseAndCreate("Veuillez selectionner votre Dossier.")
End Sub

Public Function BrowseAndCreate(Title As String) As String
    Dim Shell As Variant, Folder As Variant
    Set Shell = CreateObject("Shell.Application")
    Set Folder = Shell.BrowseForFolder(hWnd, Title, 0, "")
    BrowseAndCreate = Folder.items.Item.Path
End Function

'----------------------------------------------------------
OU
'----------------------------------------------------------

Public Function BrowseForFolder(Optional ByRef Title As String = "Please, select a directory", Optional ByRef InitialDirectory As String) As String
Dim iNull As Integer
Dim lpIDList As Long
Dim sPath As String
Dim BI As BROWSEINFO

    mBrowseFolder = InitialDirectory

    With BI
        .hwndOwner = 0
        .lpszTitle = lstrcat(Title, vbNullChar)
        .ulFlags = BIF_RETURNONLYFSDIRS Or BIF_NEWDIALOGSTYLE
        If LenB(InitialDirectory) > 0 Then
            .lpfn = ProcAddress(AddressOf BrowseCallbackProc)
        End If
    End With

    lpIDList = SHBrowseForFolder(BI)
    If lpIDList Then
        sPath = String$(MAX_PATH, 0)
        SHGetPathFromIDList lpIDList, sPath
        CoTaskMemFree lpIDList
        iNull = InStr(sPath, vbNullChar)
        If iNull Then
            sPath = Left$(sPath, iNull - 1)
        End If
    End If
    BrowseForFolder = sPath
End Function

Codes Sources

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.