GetFolder ??? répertoire par defaut autre que poste de travail
TOOCOOL
Messages postés11Date d'inscriptionlundi 30 décembre 2002StatutMembreDernière intervention26 avril 2006
-
22 sept. 2004 à 10:54
JBTHEBEST
Messages postés32Date d'inscriptionlundi 30 décembre 2002StatutMembreDerniè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
A voir également:
GetFolder ??? répertoire par defaut autre que poste de travail
crenaud76
Messages postés4172Date d'inscriptionmercredi 30 juillet 2003StatutMembreDernière intervention 9 juin 200628 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