broweforfolder personnalisé??

[palou41]

bonjour je dispose d'une fonction broweforfolder afin de choisir un sous dossier parmis les sous dossier d'un repertoire. Je voudrais si possible faire en sorte de supprimer ou de bloquer l'utilisation de creer un nouveau dossier et j'aimerai aussi interdire l'affichage de l'arborescence des sous dossiers proposés.
Pour resumer je voudrais qu'a l'apparition de boite de dialogue on ne puisse plus que selectionner un des dossiers present a l'affichage.
Merci au forum

 

[Compte Supprimé 979]

Re : broweforfolder personnalisé??

Salut Palou41

C'était SUPER COOL dimanche ....

Pour resumer je voudrais qu'a l'apparition de boite de dialogue on ne puisse plus que selectionner un des dossiers present a l'affichage.

Est-ce que ce code pourrais t'aller !

Public 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

'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
    Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
    Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Sub test()
    MsgBox GetDirectory
End Sub

Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer

    'Définit le Bureau comme dossier racine
    bInfo.pidlRoot = 0&

    'Invite de la boite de dialogue
    If IsMissing(Msg) Then
        bInfo.lpszTitle = "Selectionnez un dossier."
    Else
        bInfo.lpszTitle = Msg
    End If
    
    'Type de renvoi : dossier
'    bInfo.ulFlags = &H1
    'Type de renvoi : fichier
    bInfo.ulFlags = &H4000


    'Affiche la boite de dialogue
    x = SHBrowseForFolder(bInfo)
                        
    'Traite le résultat
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal path)
    If r Then
        pos = InStr(path, Chr$(0))
        GetDirectory = Left(path, pos - 1)
    Else
        GetDirectory = ""
    End If
End Function

Trouvé sur le site de Ce site n'existe plus

A+

 

[palou41]

Re : broweforfolder personnalisé??

Merci bcp Bruno
je ne fais que trouvé ton message désolé


L'idée est bonne, ces lignes de code me conviennent a merveille seulement qq precisions ....

Je voudrais faire partir l'ascenseur sur la droite je suppose qu'il n'est present qu'en cas de besoin si la liste est longue..

je souhaite plus particulierement ne pas partir du bureau mais d'un repertoire racine.... Je n'ai pas reussi a modifié ce parametre... bInfo.pidlRoot = 0&


Si tu as une idée.

Sinon je te met mon code actuel.... Peut etre qu'il est modifiable


Sub essai()
choix = ChoixDossierFichier("c:\msoffice\tracer\excel97", 0) '<- ici le chemin de monchoix
If choix <> "" Then MsgBox choix
End Sub

Function ChoixDossierFichier(Racine, Optional SelType As Byte = 0)
Dim objShell, objFolder, Chemin, SecuriteSlash, FlagChoix&, Msg$

If SelType = 0 Then
FlagChoix = &H1&: Msg = "Choisissez un dossier :"
Else
FlagChoix = &H4000&: Msg = "Choisissez un fichier :"
End If

Set objShell = CreateObject("Shell.Application")
'le troisième paramètre permet de choisir
'la sélection d'un dossier ou d'un fichier (0 ou 1)
'le dernier paramètre permet de choisir le dossier racine
Set objFolder = objShell.BrowseForFolder(&H0&, Msg, FlagChoix, Racine)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).path & ""
If objFolder.Title = "Bureau" Then
Chemin = "C:\Windows\Bureau"
End If
If objFolder.Title = "" Then
Chemin = ""
End If

SecuriteSlash = InStr(objFolder.Title, ":")

If SecuriteSlash > 0 Then
Chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
End If
ChoixDossierFichier = Chemin
End Function

merci encore

 

[myDearFriend!]

Re : broweforfolder personnalisé??

Bonjour palou41, BrunoM45, le Forum,

Juste en passant...

Je voudrais si possible faire en sorte de supprimer ou de bloquer l'utilisation de creer un nouveau dossier

Tu devrais obtenir ça en ajoutant la valeur &H201 (513 en décimal) à ton FlagChoix.

Cordialement,

 

[palou41]

Re : broweforfolder personnalisé??

Merci bcp dear friend

Tout est parfait j'ai meme mis &H211 j'ai de ce fait une fenetre qui m'indique le choix realisé


Merci encore.