Dossier par défaut Mini browser API Win32

[Laurent]

Bonjour à tous,
Je fais sélectionner un dossier par utilisateur via un mini browser en utilisant api windows.

comment faire pour que l'utilisiteur n'ait pas toute l'arboressance à dérouler sachant qu'il probable que dans la même macro il ouvre des répertoire proches.( pas de changement de racine ca interdit de remonter l'arboressance!)?

Merci d'avance.

le code :
Public Dossier

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
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
bInfo.lpszTitle = Msg
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)

Dossier = GetDirectory & '\\'

Else
'GetDirectory = ''
Dossier = ''


End If
End Function

appel fonction :

Ouverture_dossier:
GetDirectory (Message) 'appel de la fonction ouverture dossier avec message d'ouverture
Set fs = Application.FileSearch
With fs
.LookIn = Dossier
.Filename = '*.csv' 'ne recherche que les fichier csv
If .Execute() > 0 Then
M = .FoundFiles.Count
For J = 1 To M
'MsgBox .FoundFiles(J)
Workbooks.Open .FoundFiles(J), local:=True

Next J
ect...

 

[_Thierry]

Bonjour Laurent, le Forum

Une autre approche sans aucun appel API, mais que l'on peut paramétrer assez simplement :

Option Explicit

Function BrowsingFolder(TheDriveAndPath As Variant)
Dim ObjShell As Object, ObjFolder As Object
Dim TheMessage As String
Dim ThePath As String

TheMessage = 'Faire la Sélection du Repertoire à Scanner et répondes OK :'

Set ObjShell = CreateObject('Shell.Application')
Set ObjFolder = ObjShell.BrowseForFolder(0, TheMessage, 0, TheDriveAndPath)
   
    On Error Resume Next 'Si on sort sans sélection
    ThePath = ObjFolder.ParentFolder.ParseName(ObjFolder.Title).Path & ''
    BrowsingFolder = ThePath
End Function



Sub TestingBrowsingFolder()
Dim ActualPath As Variant
Dim SelectedPathFolder As String

ActualPath = 'C:\Documents and Settings\TE\My Documents\Acrobat\' '<<< A Adapter


&nbsp; &nbsp; SelectedPathFolder = BrowsingFolder(ActualPath)
&nbsp; &nbsp; If Not SelectedPathFolder = Empty Then MsgBox SelectedPathFolder

End Sub

Démo en exemple concret d'utilisation :

=> Lien supprimé


Bon Après Midi
[ol]@+Thierry[/ol]

 

[Laurent]

Bonjour Thierry,

Ta methode est effectivement moins complexe que celle que j'avais trouver sur le Net, mais malheureusement ne résout pas mon Pb. Une fois que l'on a défini ActualPath, ça interdit à l'opérateur de remonter dans l'arboressence ;/.
Ta contribution est cepandant trés intéressante est je la garde précieusement.

S@lut@tions
L

PS : Je suis planté depuis quatre jours sur ce pb, je suis donc ouvert à toutes proposition ( en terme de ligne de code... ;-))

 

[_Thierry]

Bonjour Laurent, le Forum

D'après ce que je connais, aucune des deux méthodes (BrowseForFolder de l'objet Shell.Application ou bien par l'API SHBrowseForFolder) ne semble permettre l'intégration du bouton 'Retour Sur Racine' ...

Voici des liens MSDN si tu as la patience de chercher (en anglais) :


Ce lien n'existe plus


Ce lien n'existe plus


Ce lien n'existe plus

Bon Courage et Bonne Journée.... 'T.G.I.F. !!!'

[ol]@+Thierry[/ol]