GetFolder ??? répertoire par defaut autre que poste de travail

Salut,

j'utilise la fonction GetFolder (trouvée sur VBFrance) pour sélectionner via une boite de dialogue un répertoire.

le probleme c est qu elle est positionnée toujours au démarrage sur poste de travail... y aurait il un moyen pour lui declarer le app.path par defaut ?

voici le code ci-dessous des déclarations et de la fonction

merci d'avance pour votre aide !!!

A+
TOOCOOL



' ****** pour afficher une boite de dialogue Repertoire ******
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
'These constants are to be set to the ul
' Flags property in the BROWSEINFO type de
' pending of what result you want
Const BIF_RETURNONLYFSDIRS = &H1 'Allows you To browse For system folders only.
Const BIF_DONTGOBELOWDOMAIN = &H2 'Using this value forces the _
user To stay within the domain level of the _
Network Neighborhhood
Const BIF_STATUSTEXT = &H4 'Displays a statusbar on the selection dialog
Const BIF_RETURNFSANCESTORS = &H8 'Returns file system ancestor only
Const BIF_BROWSEFORCOMPUTER = &H1000 'Allows you To browse for a computer
Const BIF_BROWSEFORPRINTER = &H2000 'Allows you To browse the Printers folder

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
')) ****** FIN pour afficher une boite de dialogue Repertoire ******

Function GetFolder(Optional Title As String, Optional hwnd) As String
')) affiche une boite de dialogue de repertoire uniquement (PAS DE FICHIERS)

Dim bi As BROWSEINFO
Dim pidl As Long
Dim Folder As String
Folder = String$(255, Chr$(0))


With bi
If IsNumeric(hwnd) Then .hOwner = hwnd
.ulFlags = BIF_RETURNONLYFSDIRS
.pidlRoot = 0
If IsNull(Title) Then
'If Not IsMissing(Title) Then
.lpszTitle = Title
Else
.lpszTitle = "Sélectionner un répertoire :" & Chr$(0)
End If
End With
pidl = SHBrowseForFolder(bi)


If SHGetPathFromIDList(ByVal pidl, ByVal Folder) Then
GetFolder = Left(Folder, InStr(Folder, Chr$(0)) - 1)
Else
GetFolder = ""
End If
End Function

Normal ! Il faut faire un peu de SubClassing pour cela. Voici un code qui fonctionne :
Dasn un module standard, colle ceci :

Private Const WM_USER = &H400 Private Const BFFM_INITIALIZED = 1 Private Const BFFM_SETSELECTIONA = (WM_USER + 102) Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Public BFFInitialPath As String Public Function BrowseForFolderCallBackFunc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long 'callback-funktion für ordnerwahl-dialog Select Case uMsg Case BFFM_INITIALIZED If Len(BFFInitialPath) > 0 Then SendMessage hwnd, BFFM_SETSELECTIONA, 1, ByVal BFFInitialPath End If End Select End Function Private Function GetAddress(Adr As Long) As Long GetAddress = Adr End Function Public Function ShowBrowseForFolderDlg(ByVal hwnd As Long, ByVal Msg As String, Optional ByVal InitDir As String) As String Dim iNull As Integer, lpIDList As Long, sPath As String, udtBI As BrowseInfo With udtBI .hWndOwner = hwnd .lpszTitle = lstrcat(Msg, "") .ulFlags = BIF_RETURNONLYFSDIRS + BIF_NEWDIALOGSTYLE .lpfnCallback = GetAddress(AddressOf BrowseForFolderCallBackFunc) End With BFFInitialPath = InitDir lpIDList = SHBrowseForFolder(udtBI) 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 ShowBrowseForFolderDlg = sPath End Function

Appel ensuite la fonction "ShowBrowseForFolderDlg()" avec les param qui vont bien. Ca devarit passer

Christophe R.

S'il te plais tu peux pas nous faire une source car il y a plein de variable inconnu !

ça en depannerais plus d'un (surtout moi)

merci d'avance

J&B