Créer un nouveau dossier avec boite de dialogue commune [Résolu]

Signaler
Messages postés
61
Date d'inscription
dimanche 21 décembre 2003
Statut
Membre
Dernière intervention
18 janvier 2009
-
Messages postés
2
Date d'inscription
vendredi 14 janvier 2005
Statut
Membre
Dernière intervention
3 janvier 2016
-
Bonjour,

Je cherche un moyen d'afficher le bouton "Créer un nouveau dossier" dans la boite de dialogue "sélectionner un dossier"

j'ai trouvé cette source sur Allapi.net mais le bouton n'apparait pas :

Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Const BIF_RETURNONLYFSDIRS = 1
Const MAX_PATH = 260
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Sub Form_Load()
'KPD-Team 1998
'URL: http://www.allapi.net/
'KPDTeam@Allapi.net
Dim iNull As Integer, lpIDList As Long, lResult As Long
Dim sPath As String, udtBI As BrowseInfo

With udtBI
'Set the owner window
.hWndOwner = Me.hWnd
'lstrcat appends the two strings and returns the memory address
.lpszTitle = lstrcat("C:", "")
'Return only if the user selected a directory
.ulFlags = BIF_RETURNONLYFSDIRS
End With

'Show the 'Browse for folder' dialog
lpIDList = SHBrowseForFolder(udtBI)
If lpIDList Then
sPath = String$(MAX_PATH, 0)
'Get the path from the IDList
SHGetPathFromIDList lpIDList, sPath
'free the block of memory
CoTaskMemFree lpIDList
iNull = InStr(sPath, vbNullChar)
If iNull Then
sPath = Left$(sPath, iNull - 1)
End If
End If

MsgBox sPath
End Sub

Quelqu'un sait-il comment faire ?
Jonas :big)

4 réponses

Messages postés
61
Date d'inscription
dimanche 21 décembre 2003
Statut
Membre
Dernière intervention
18 janvier 2009

Solution :

'BROWSEINFO.ulFlags values
Private Const BIF_RETURNONLYFSDIRS   As Long = &H1 'only file system directories
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2  'no network folders below domain level
Private Const BIF_STATUSTEXT As Long = &H4         'include status area for callback
Private Const BIF_RETURNFSANCESTORS As Long = &H8  'only return file system ancestors
Private Const BIF_EDITBOX As Long = &H10           'add edit box
Private Const BIF_NEWDIALOGSTYLE As Long = &H40    'use the new dialog layout
Private Const BIF_UAHINT As Long = &H100
Private Const BIF_NONEWFOLDERBUTTON As Long = &H200 'hide new folder button
Private Const BIF_NOTRANSLATETARGETS As Long = &H400 'return lnk file
Private Const BIF_USENEWUI As Long = BIF_NEWDIALOGSTYLE Or BIF_EDITBOX
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000 'only return computers
Private Const BIF_BROWSEFORPRINTER As Long = &H2000 'only return printers
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000 'browse for everything
Private Const BIF_SHAREABLE As Long = &H8000 'sharable resources, requires BIF_USENEWUI

.ulFlags = BIF_RETURNONLYFSDIRS + BIF_EDITBOX + BIF_NEWDIALOGSTYLE

Jonas
3
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 123 internautes nous ont dit merci ce mois-ci

Messages postés
575
Date d'inscription
dimanche 23 décembre 2001
Statut
Membre
Dernière intervention
23 octobre 2012

-- Dans un module --
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const MAX_PATH As Long = 260

Function BrowseFolder(Optional Caption As String, _
Optional InitialFolder As String) As String

Dim SH As Shell32ctl.Shell
Dim F As Shell32ctl.Folder

Set SH = New Shell32ctl.Shell
Set F = SH.BrowseForFolder(0&, Caption, BIF_RETURNONLYFSDIRS, _
InitialFolder)

If Not F Is Nothing Then
BrowseFolder = F.Items.Item.Path
End If

End Function

-- Dans un form --

Dim FName As String
FName = BrowseFolder("Select a folder", "C:\InitialFolder")
If FName = "" Then
MsgBox "You didn't select a folder"
Else
MsgBox "You selected: " & FName
End If

Ajouttes dans les références de ton projet le fichier : c:\windows\system32\shell32.oca

ou sinon ajouttes dans les controles la référence vers l'objet Microsoft Shell Controls And Automation.

Bonne prog et à +, akh
Messages postés
61
Date d'inscription
dimanche 21 décembre 2003
Statut
Membre
Dernière intervention
18 janvier 2009

Merci ... mais

je ne possède pas le fichier "c:\windows\system32\shell32.oca" alors j'ai fais une référence vers "c:\windows\system32\Shell32.dll" mais le code ne fonctionne pas :
---
Dim SH As Shell32ctl.Shell
Dim F As Shell32ctl.Folder
----
les types "shell32ctl.shell" et "shell32ctl.folder" ne sont pas reconnus.

quelqu'un pourrait-il m'aider ???

Jonas :big)
Messages postés
2
Date d'inscription
vendredi 14 janvier 2005
Statut
Membre
Dernière intervention
3 janvier 2016

Merci JonasVB, la liste des constantes m'a été très utile.

en ce qui me concerne sous VB 5
mettre
.ulFlags = BIF_USENEWUI fait apparaître "nouveau dossier"
et mettre
.ulFlags = BIF_USENEWUI + BIF_NONEWFOLDERBUTTON fait disparaître "nouveau dossier"

c'est ce que je voulais programmer.

JM