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

TOOCOOL
Messages postés
11
Date d'inscription
lundi 30 décembre 2002
Statut
Membre
Dernière intervention
26 avril 2006
- 22 sept. 2004 à 10:54
JBTHEBEST
Messages postés
32
Date d'inscription
lundi 30 décembre 2002
Statut
Membre
Dernière intervention
1 décembre 2004
- 1 déc. 2004 à 17:37
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

2 réponses

crenaud76
Messages postés
4172
Date d'inscription
mercredi 30 juillet 2003
Statut
Membre
Dernière intervention
9 juin 2006
28
22 sept. 2004 à 11:02
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.
0
JBTHEBEST
Messages postés
32
Date d'inscription
lundi 30 décembre 2002
Statut
Membre
Dernière intervention
1 décembre 2004

1 déc. 2004 à 17:37
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
0