Bonjour,
En VB/VBA j'ai le code suivant, après avoir mis en référence
Microsoft Shell Controls and Automation
Set Fldr = SH.BrowseForFolder(0, "Choisissez un répertoire", 0, "D:")
Bonjour,
En VB/VBA j'ai le code suivant, après avoir mis en référence
Microsoft Shell Controls and Automation
Set Fldr = SH.BrowseForFolder(0, "Choisissez un répertoire", 0, "D:")
Bonjour,
En VB/VBA j'ai le code suivant, après avoir mis en référence
Microsoft Shell Controls and Automation
Set Fldr = SH.BrowseForFolder(0, "Choisissez un répertoire", 0, "D:")
Bonjour,
En VB/VBA j'ai le code suivant, après avoir mis en référence Microsoft
Shell Controls and Automation
Sub main()
Dim SH As Shell32.Shell
Dim Fldr As Shell32.Folder2
Set SH = New Shell32.Shell
Set Fldr = SH.BrowseForFolder(0, "Choisissez un répertoire", 0, "D:")
If Fldr Is Nothing Then
MsgBox "Commande annulée"
Else
MsgBox "Vous avez choisi : " & Fldr.Self.Path
End If
End Sub
Tout se passe bien mais je ne voudrais pas avoir le bouton "Créer un
nouveau dossier"
Est-ce possible?
PS : je ne peux pas utiliser les contôles DriveList et DirList de VB car
mon but est de travailler en VBA AutoCAD ou ces contrôles nexistent pas,
alors que le code ci-dessus fonctionne en VBA AutoCAD.
Merci de l'attention portée à mon message
Bonjour,
En VB/VBA j'ai le code suivant, après avoir mis en référence Microsoft
Shell Controls and Automation
Sub main()
Dim SH As Shell32.Shell
Dim Fldr As Shell32.Folder2
Set SH = New Shell32.Shell
Set Fldr = SH.BrowseForFolder(0, "Choisissez un répertoire", 0, "D:")
If Fldr Is Nothing Then
MsgBox "Commande annulée"
Else
MsgBox "Vous avez choisi : " & Fldr.Self.Path
End If
End Sub
Tout se passe bien mais je ne voudrais pas avoir le bouton "Créer un
nouveau dossier"
Est-ce possible?
PS : je ne peux pas utiliser les contôles DriveList et DirList de VB car
mon but est de travailler en VBA AutoCAD ou ces contrôles nexistent pas,
alors que le code ci-dessus fonctionne en VBA AutoCAD.
Merci de l'attention portée à mon message
Bonjour,
En VB/VBA j'ai le code suivant, après avoir mis en référence Microsoft
Shell Controls and Automation
Sub main()
Dim SH As Shell32.Shell
Dim Fldr As Shell32.Folder2
Set SH = New Shell32.Shell
Set Fldr = SH.BrowseForFolder(0, "Choisissez un répertoire", 0, "D:")
If Fldr Is Nothing Then
MsgBox "Commande annulée"
Else
MsgBox "Vous avez choisi : " & Fldr.Self.Path
End If
End Sub
Tout se passe bien mais je ne voudrais pas avoir le bouton "Créer un
nouveau dossier"
Est-ce possible?
PS : je ne peux pas utiliser les contôles DriveList et DirList de VB car
mon but est de travailler en VBA AutoCAD ou ces contrôles nexistent pas,
alors que le code ci-dessus fonctionne en VBA AutoCAD.
Merci de l'attention portée à mon message
dans : news:452770d4$0$5107$,
Bernard Flavignard écrivait :Bonjour,
En VB/VBA j'ai le code suivant, après avoir mis en référence
Microsoft Shell Controls and Automation
Set Fldr = SH.BrowseForFolder(0, "Choisissez un répertoire", 0, "D:")
En troisième paramètre, il te faut mettre une combinaison de constantes que tu
trouveras, par exemple, ici :
http://vbnet.mvps.org/index.html?code/browse/browsenetwork.htm
Il s'agit des constantes débutant par BIF_
Et en particulier BIF_NONEWFOLDERBUTTON (&H200)
--
Fred
http://www.cerbermail.com/?3kA6ftaCvT
dans : news:452770d4$0$5107$ba4acef3@news.orange.fr,
Bernard Flavignard écrivait :
Bonjour,
En VB/VBA j'ai le code suivant, après avoir mis en référence
Microsoft Shell Controls and Automation
Set Fldr = SH.BrowseForFolder(0, "Choisissez un répertoire", 0, "D:")
En troisième paramètre, il te faut mettre une combinaison de constantes que tu
trouveras, par exemple, ici :
http://vbnet.mvps.org/index.html?code/browse/browsenetwork.htm
Il s'agit des constantes débutant par BIF_
Et en particulier BIF_NONEWFOLDERBUTTON (&H200)
--
Fred
http://www.cerbermail.com/?3kA6ftaCvT
dans : news:452770d4$0$5107$,
Bernard Flavignard écrivait :Bonjour,
En VB/VBA j'ai le code suivant, après avoir mis en référence
Microsoft Shell Controls and Automation
Set Fldr = SH.BrowseForFolder(0, "Choisissez un répertoire", 0, "D:")
En troisième paramètre, il te faut mettre une combinaison de constantes que tu
trouveras, par exemple, ici :
http://vbnet.mvps.org/index.html?code/browse/browsenetwork.htm
Il s'agit des constantes débutant par BIF_
Et en particulier BIF_NONEWFOLDERBUTTON (&H200)
--
Fred
http://www.cerbermail.com/?3kA6ftaCvT
Bonjour Bernard Flavignard,
Bernard Flavignard a écrit :Bonjour,
En VB/VBA j'ai le code suivant, après avoir mis en référence Microsoft Shell
Controls and Automation
Sub main()
Dim SH As Shell32.Shell
Dim Fldr As Shell32.Folder2
Set SH = New Shell32.Shell
Set Fldr = SH.BrowseForFolder(0, "Choisissez un répertoire", 0, "D:")
If Fldr Is Nothing Then
MsgBox "Commande annulée"
Else
MsgBox "Vous avez choisi : " & Fldr.Self.Path
End If
End Sub
Tout se passe bien mais je ne voudrais pas avoir le bouton "Créer un nouveau
dossier"
Est-ce possible?
PS : je ne peux pas utiliser les contôles DriveList et DirList de VB car mon
but est de travailler en VBA AutoCAD ou ces contrôles nexistent pas, alors
que le code ci-dessus fonctionne en VBA AutoCAD.
Merci de l'attention portée à mon message
Il faut renseigner de manière adéquate le 3ème paramètre, avec
BIF_NONEWFOLDERBUTTON :
<http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/objects/shell/browseforfolder.asp>
Option Explicit
Private Const MAX_PATH = 260
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_STATUSTEXT As Long = &H4
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_EDITBOX As Long = &H10
Private Const BIF_VALIDATE As Long = &H20
Private Const BIF_NEWDIALOGSTYLE As Long = &H40
Private Const BIF_USENEWUI As Long = (BIF_NEWDIALOGSTYLE Or BIF_EDITBOX)
Private Const BIF_BROWSEINCLUDEURLS As Long = &H80
Private Const BIF_UAHINT As Long = &H100
Private Const BIF_NONEWFOLDERBUTTON As Long = &H200
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const BIF_SHAREABLE As Long = &H8000&
Private Sub Main()
Dim SH As Shell32.Shell
Dim Fldr As Shell32.Folder2
Dim uFlags As Integer
Set SH = New Shell32.Shell
uFlags = BIF_NONEWFOLDERBUTTON
Set Fldr = SH.BrowseForFolder(0, "Choisissez un répertoire", uFlags, "D:")
If Fldr Is Nothing Then
MsgBox "Commande annulée"
Else
MsgBox "Vous avez choisi : " & Fldr.Self.Path
End If
End Sub
' --------------------
Et arrivé à ce point là, si tu veux avoir plus de souplesse, autant utiliser
l'API :
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpbi As BrowseInfo) As Long
conjointement avec la structure BrowseInfo :
Private Type BrowseInfo
hwndOwner 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
<http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/structures/browseinfo.asp>
Cela t'affranchira également de la référence à :
Microsoft Shell Controls and Automation
--
Cordialement,
Jacques.
Bonjour Bernard Flavignard,
Bernard Flavignard a écrit :
Bonjour,
En VB/VBA j'ai le code suivant, après avoir mis en référence Microsoft Shell
Controls and Automation
Sub main()
Dim SH As Shell32.Shell
Dim Fldr As Shell32.Folder2
Set SH = New Shell32.Shell
Set Fldr = SH.BrowseForFolder(0, "Choisissez un répertoire", 0, "D:")
If Fldr Is Nothing Then
MsgBox "Commande annulée"
Else
MsgBox "Vous avez choisi : " & Fldr.Self.Path
End If
End Sub
Tout se passe bien mais je ne voudrais pas avoir le bouton "Créer un nouveau
dossier"
Est-ce possible?
PS : je ne peux pas utiliser les contôles DriveList et DirList de VB car mon
but est de travailler en VBA AutoCAD ou ces contrôles nexistent pas, alors
que le code ci-dessus fonctionne en VBA AutoCAD.
Merci de l'attention portée à mon message
Il faut renseigner de manière adéquate le 3ème paramètre, avec
BIF_NONEWFOLDERBUTTON :
<http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/objects/shell/browseforfolder.asp>
Option Explicit
Private Const MAX_PATH = 260
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_STATUSTEXT As Long = &H4
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_EDITBOX As Long = &H10
Private Const BIF_VALIDATE As Long = &H20
Private Const BIF_NEWDIALOGSTYLE As Long = &H40
Private Const BIF_USENEWUI As Long = (BIF_NEWDIALOGSTYLE Or BIF_EDITBOX)
Private Const BIF_BROWSEINCLUDEURLS As Long = &H80
Private Const BIF_UAHINT As Long = &H100
Private Const BIF_NONEWFOLDERBUTTON As Long = &H200
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const BIF_SHAREABLE As Long = &H8000&
Private Sub Main()
Dim SH As Shell32.Shell
Dim Fldr As Shell32.Folder2
Dim uFlags As Integer
Set SH = New Shell32.Shell
uFlags = BIF_NONEWFOLDERBUTTON
Set Fldr = SH.BrowseForFolder(0, "Choisissez un répertoire", uFlags, "D:")
If Fldr Is Nothing Then
MsgBox "Commande annulée"
Else
MsgBox "Vous avez choisi : " & Fldr.Self.Path
End If
End Sub
' --------------------
Et arrivé à ce point là, si tu veux avoir plus de souplesse, autant utiliser
l'API :
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpbi As BrowseInfo) As Long
conjointement avec la structure BrowseInfo :
Private Type BrowseInfo
hwndOwner 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
<http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/structures/browseinfo.asp>
Cela t'affranchira également de la référence à :
Microsoft Shell Controls and Automation
--
Cordialement,
Jacques.
Bonjour Bernard Flavignard,
Bernard Flavignard a écrit :Bonjour,
En VB/VBA j'ai le code suivant, après avoir mis en référence Microsoft Shell
Controls and Automation
Sub main()
Dim SH As Shell32.Shell
Dim Fldr As Shell32.Folder2
Set SH = New Shell32.Shell
Set Fldr = SH.BrowseForFolder(0, "Choisissez un répertoire", 0, "D:")
If Fldr Is Nothing Then
MsgBox "Commande annulée"
Else
MsgBox "Vous avez choisi : " & Fldr.Self.Path
End If
End Sub
Tout se passe bien mais je ne voudrais pas avoir le bouton "Créer un nouveau
dossier"
Est-ce possible?
PS : je ne peux pas utiliser les contôles DriveList et DirList de VB car mon
but est de travailler en VBA AutoCAD ou ces contrôles nexistent pas, alors
que le code ci-dessus fonctionne en VBA AutoCAD.
Merci de l'attention portée à mon message
Il faut renseigner de manière adéquate le 3ème paramètre, avec
BIF_NONEWFOLDERBUTTON :
<http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/objects/shell/browseforfolder.asp>
Option Explicit
Private Const MAX_PATH = 260
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_STATUSTEXT As Long = &H4
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_EDITBOX As Long = &H10
Private Const BIF_VALIDATE As Long = &H20
Private Const BIF_NEWDIALOGSTYLE As Long = &H40
Private Const BIF_USENEWUI As Long = (BIF_NEWDIALOGSTYLE Or BIF_EDITBOX)
Private Const BIF_BROWSEINCLUDEURLS As Long = &H80
Private Const BIF_UAHINT As Long = &H100
Private Const BIF_NONEWFOLDERBUTTON As Long = &H200
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const BIF_SHAREABLE As Long = &H8000&
Private Sub Main()
Dim SH As Shell32.Shell
Dim Fldr As Shell32.Folder2
Dim uFlags As Integer
Set SH = New Shell32.Shell
uFlags = BIF_NONEWFOLDERBUTTON
Set Fldr = SH.BrowseForFolder(0, "Choisissez un répertoire", uFlags, "D:")
If Fldr Is Nothing Then
MsgBox "Commande annulée"
Else
MsgBox "Vous avez choisi : " & Fldr.Self.Path
End If
End Sub
' --------------------
Et arrivé à ce point là, si tu veux avoir plus de souplesse, autant utiliser
l'API :
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpbi As BrowseInfo) As Long
conjointement avec la structure BrowseInfo :
Private Type BrowseInfo
hwndOwner 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
<http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/structures/browseinfo.asp>
Cela t'affranchira également de la référence à :
Microsoft Shell Controls and Automation
--
Cordialement,
Jacques.
Jacques,
Un grand merci pour ta réponse.
La première partie ne me pose pas de problèmes, ça fonctionne.
Tu me proposes d'appeler l'API, je veux bien, je fais les déclarations
mais je suis un peu perdu ensuite pour écrire le code pour l'appeler.
Je ne pense pas que ce soit compliqué mais je ne vois pas quoi mettre
pour lpbi.
Merci si tu peux m'en dire un peu plus.
Salutations
Jacques,
Un grand merci pour ta réponse.
La première partie ne me pose pas de problèmes, ça fonctionne.
Tu me proposes d'appeler l'API, je veux bien, je fais les déclarations
mais je suis un peu perdu ensuite pour écrire le code pour l'appeler.
Je ne pense pas que ce soit compliqué mais je ne vois pas quoi mettre
pour lpbi.
Merci si tu peux m'en dire un peu plus.
Salutations
Jacques,
Un grand merci pour ta réponse.
La première partie ne me pose pas de problèmes, ça fonctionne.
Tu me proposes d'appeler l'API, je veux bien, je fais les déclarations
mais je suis un peu perdu ensuite pour écrire le code pour l'appeler.
Je ne pense pas que ce soit compliqué mais je ne vois pas quoi mettre
pour lpbi.
Merci si tu peux m'en dire un peu plus.
Salutations
Bonjour Bernard Flavignard,
Bernard Flavignard a écrit :Jacques,
Un grand merci pour ta réponse.
La première partie ne me pose pas de problèmes, ça fonctionne.
Tu me proposes d'appeler l'API, je veux bien, je fais les déclarations mais
je suis un peu perdu ensuite pour écrire le code pour l'appeler.
Je ne pense pas que ce soit compliqué mais je ne vois pas quoi mettre pour
lpbi.
Merci si tu peux m'en dire un peu plus.
Salutations
Il faut déclarer une variable de type BrowseInfo, et la passer comme paramètre
de l'API (en ayant renseigné les différents champs de la structure). Par
exemple, dans un module :
' -----------------------------------------------------------------
Option Explicit
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long
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
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Const MAX_PATH = 260
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_STATUSTEXT As Long = &H4
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_EDITBOX As Long = &H10
Private Const BIF_VALIDATE As Long = &H20
Private Const BIF_NEWDIALOGSTYLE As Long = &H40
Private Const BIF_USENEWUI As Long = (BIF_NEWDIALOGSTYLE Or BIF_EDITBOX)
Private Const BIF_BROWSEINCLUDEURLS As Long = &H80
Private Const BIF_UAHINT As Long = &H100
Private Const BIF_NONEWFOLDERBUTTON As Long = &H200
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const BIF_SHAREABLE As Long = &H8000&
Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_SETSTATUSTEXTA = (WM_USER + 100)
Private Const BFFM_SETSELECTIONA = (WM_USER + 102)
Private Type BrowseInfo
hwndOwner 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
Private mStartFolder As String
Public Function BrowseForFolder(ByVal Owner As Long, _
Optional StartFolder As String = "", _
Optional Caption As String = "", _
Optional ShowFiles As Boolean = False) As
String
Dim bInfo As BrowseInfo
Dim sResult As String
Dim lResult As Long
With bInfo
.hwndOwner = Owner
.pIDLRoot = 0
.pszDisplayName = String$(MAX_PATH, Chr$(0))
If Len(Caption) > 0 Then
.lpszTitle = Caption
End If
.ulFlags = BIF_RETURNONLYFSDIRS Or BIF_NEWDIALOGSTYLE
If ShowFiles Then
.ulFlags = .ulFlags Or BIF_BROWSEINCLUDEFILES
End If
.ulFlags = .ulFlags Or BIF_NONEWFOLDERBUTTON
.lpfn = GetAddress(AddressOf BrowseCallbackProc)
.lParam = 0
.iImage = 0
mStartFolder = StartFolder
lResult = SHBrowseForFolder(bInfo)
If lResult <> 0 Then
sResult = String(MAX_PATH, 0)
If SHGetPathFromIDList(lResult, sResult) Then
BrowseForFolder = Left(sResult, InStr(sResult, Chr$(0)) - 1)
End If
CoTaskMemFree lResult
End If
End With
End Function
Private Function BrowseCallbackProc(ByVal hwnd As Long, ByVal uMsg As Long,
ByVal lParam As Long, ByVal lpData As Long) As Long
Select Case uMsg
Case BFFM_INITIALIZED
If Len(mStartFolder) > 0 Then
SendMessage hwnd, BFFM_SETSELECTIONA, True, ByVal mStartFolder
End If
End Select
End Function
Private Function GetAddress(Addr As Long) As Long
GetAddress = Addr
End Function
' -------------------------------------------------------------------
Que tu peux appeler en VB6, par exemple avec :
s = BrowseForFolder(Me.hwnd)
MsgBox s
s = BrowseForFolder(Me.hwnd, "D:", _
"Sélectionner un répertoire", False)
MsgBox s
s = BrowseForFolder(Me.hwnd, "D:", "Sélectionner un fichier", True)
MsgBox s
En VBA, le fait de ne pas connaitre le Handle de la fenêtre appelante
(Me.hWnd) ne devrait pas poser de problème, le laisser à zéro rendra le bureau
propriétaire de la fenêtre.
--
Cordialement,
Jacques.
Bonjour Bernard Flavignard,
Bernard Flavignard a écrit :
Jacques,
Un grand merci pour ta réponse.
La première partie ne me pose pas de problèmes, ça fonctionne.
Tu me proposes d'appeler l'API, je veux bien, je fais les déclarations mais
je suis un peu perdu ensuite pour écrire le code pour l'appeler.
Je ne pense pas que ce soit compliqué mais je ne vois pas quoi mettre pour
lpbi.
Merci si tu peux m'en dire un peu plus.
Salutations
Il faut déclarer une variable de type BrowseInfo, et la passer comme paramètre
de l'API (en ayant renseigné les différents champs de la structure). Par
exemple, dans un module :
' -----------------------------------------------------------------
Option Explicit
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long
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
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Const MAX_PATH = 260
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_STATUSTEXT As Long = &H4
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_EDITBOX As Long = &H10
Private Const BIF_VALIDATE As Long = &H20
Private Const BIF_NEWDIALOGSTYLE As Long = &H40
Private Const BIF_USENEWUI As Long = (BIF_NEWDIALOGSTYLE Or BIF_EDITBOX)
Private Const BIF_BROWSEINCLUDEURLS As Long = &H80
Private Const BIF_UAHINT As Long = &H100
Private Const BIF_NONEWFOLDERBUTTON As Long = &H200
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const BIF_SHAREABLE As Long = &H8000&
Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_SETSTATUSTEXTA = (WM_USER + 100)
Private Const BFFM_SETSELECTIONA = (WM_USER + 102)
Private Type BrowseInfo
hwndOwner 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
Private mStartFolder As String
Public Function BrowseForFolder(ByVal Owner As Long, _
Optional StartFolder As String = "", _
Optional Caption As String = "", _
Optional ShowFiles As Boolean = False) As
String
Dim bInfo As BrowseInfo
Dim sResult As String
Dim lResult As Long
With bInfo
.hwndOwner = Owner
.pIDLRoot = 0
.pszDisplayName = String$(MAX_PATH, Chr$(0))
If Len(Caption) > 0 Then
.lpszTitle = Caption
End If
.ulFlags = BIF_RETURNONLYFSDIRS Or BIF_NEWDIALOGSTYLE
If ShowFiles Then
.ulFlags = .ulFlags Or BIF_BROWSEINCLUDEFILES
End If
.ulFlags = .ulFlags Or BIF_NONEWFOLDERBUTTON
.lpfn = GetAddress(AddressOf BrowseCallbackProc)
.lParam = 0
.iImage = 0
mStartFolder = StartFolder
lResult = SHBrowseForFolder(bInfo)
If lResult <> 0 Then
sResult = String(MAX_PATH, 0)
If SHGetPathFromIDList(lResult, sResult) Then
BrowseForFolder = Left(sResult, InStr(sResult, Chr$(0)) - 1)
End If
CoTaskMemFree lResult
End If
End With
End Function
Private Function BrowseCallbackProc(ByVal hwnd As Long, ByVal uMsg As Long,
ByVal lParam As Long, ByVal lpData As Long) As Long
Select Case uMsg
Case BFFM_INITIALIZED
If Len(mStartFolder) > 0 Then
SendMessage hwnd, BFFM_SETSELECTIONA, True, ByVal mStartFolder
End If
End Select
End Function
Private Function GetAddress(Addr As Long) As Long
GetAddress = Addr
End Function
' -------------------------------------------------------------------
Que tu peux appeler en VB6, par exemple avec :
s = BrowseForFolder(Me.hwnd)
MsgBox s
s = BrowseForFolder(Me.hwnd, "D:", _
"Sélectionner un répertoire", False)
MsgBox s
s = BrowseForFolder(Me.hwnd, "D:", "Sélectionner un fichier", True)
MsgBox s
En VBA, le fait de ne pas connaitre le Handle de la fenêtre appelante
(Me.hWnd) ne devrait pas poser de problème, le laisser à zéro rendra le bureau
propriétaire de la fenêtre.
--
Cordialement,
Jacques.
Bonjour Bernard Flavignard,
Bernard Flavignard a écrit :Jacques,
Un grand merci pour ta réponse.
La première partie ne me pose pas de problèmes, ça fonctionne.
Tu me proposes d'appeler l'API, je veux bien, je fais les déclarations mais
je suis un peu perdu ensuite pour écrire le code pour l'appeler.
Je ne pense pas que ce soit compliqué mais je ne vois pas quoi mettre pour
lpbi.
Merci si tu peux m'en dire un peu plus.
Salutations
Il faut déclarer une variable de type BrowseInfo, et la passer comme paramètre
de l'API (en ayant renseigné les différents champs de la structure). Par
exemple, dans un module :
' -----------------------------------------------------------------
Option Explicit
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long
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
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Const MAX_PATH = 260
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_STATUSTEXT As Long = &H4
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_EDITBOX As Long = &H10
Private Const BIF_VALIDATE As Long = &H20
Private Const BIF_NEWDIALOGSTYLE As Long = &H40
Private Const BIF_USENEWUI As Long = (BIF_NEWDIALOGSTYLE Or BIF_EDITBOX)
Private Const BIF_BROWSEINCLUDEURLS As Long = &H80
Private Const BIF_UAHINT As Long = &H100
Private Const BIF_NONEWFOLDERBUTTON As Long = &H200
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const BIF_SHAREABLE As Long = &H8000&
Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_SETSTATUSTEXTA = (WM_USER + 100)
Private Const BFFM_SETSELECTIONA = (WM_USER + 102)
Private Type BrowseInfo
hwndOwner 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
Private mStartFolder As String
Public Function BrowseForFolder(ByVal Owner As Long, _
Optional StartFolder As String = "", _
Optional Caption As String = "", _
Optional ShowFiles As Boolean = False) As
String
Dim bInfo As BrowseInfo
Dim sResult As String
Dim lResult As Long
With bInfo
.hwndOwner = Owner
.pIDLRoot = 0
.pszDisplayName = String$(MAX_PATH, Chr$(0))
If Len(Caption) > 0 Then
.lpszTitle = Caption
End If
.ulFlags = BIF_RETURNONLYFSDIRS Or BIF_NEWDIALOGSTYLE
If ShowFiles Then
.ulFlags = .ulFlags Or BIF_BROWSEINCLUDEFILES
End If
.ulFlags = .ulFlags Or BIF_NONEWFOLDERBUTTON
.lpfn = GetAddress(AddressOf BrowseCallbackProc)
.lParam = 0
.iImage = 0
mStartFolder = StartFolder
lResult = SHBrowseForFolder(bInfo)
If lResult <> 0 Then
sResult = String(MAX_PATH, 0)
If SHGetPathFromIDList(lResult, sResult) Then
BrowseForFolder = Left(sResult, InStr(sResult, Chr$(0)) - 1)
End If
CoTaskMemFree lResult
End If
End With
End Function
Private Function BrowseCallbackProc(ByVal hwnd As Long, ByVal uMsg As Long,
ByVal lParam As Long, ByVal lpData As Long) As Long
Select Case uMsg
Case BFFM_INITIALIZED
If Len(mStartFolder) > 0 Then
SendMessage hwnd, BFFM_SETSELECTIONA, True, ByVal mStartFolder
End If
End Select
End Function
Private Function GetAddress(Addr As Long) As Long
GetAddress = Addr
End Function
' -------------------------------------------------------------------
Que tu peux appeler en VB6, par exemple avec :
s = BrowseForFolder(Me.hwnd)
MsgBox s
s = BrowseForFolder(Me.hwnd, "D:", _
"Sélectionner un répertoire", False)
MsgBox s
s = BrowseForFolder(Me.hwnd, "D:", "Sélectionner un fichier", True)
MsgBox s
En VBA, le fait de ne pas connaitre le Handle de la fenêtre appelante
(Me.hWnd) ne devrait pas poser de problème, le laisser à zéro rendra le bureau
propriétaire de la fenêtre.
--
Cordialement,
Jacques.
Bonjour,
En VB/VBA j'ai le code suivant, après avoir mis en référence Microsoft Shell
Controls and Automation
Sub main()
Dim SH As Shell32.Shell
Dim Fldr As Shell32.Folder2
Set SH = New Shell32.Shell
Set Fldr = SH.BrowseForFolder(0, "Choisissez un répertoire", 0, "D:")
If Fldr Is Nothing Then
MsgBox "Commande annulée"
Else
MsgBox "Vous avez choisi : " & Fldr.Self.Path
End If
End Sub
Tout se passe bien mais je ne voudrais pas avoir le bouton "Créer un nouveau
dossier"
Est-ce possible?
PS : je ne peux pas utiliser les contôles DriveList et DirList de VB car mon
but est de travailler en VBA AutoCAD ou ces contrôles nexistent pas, alors que
le code ci-dessus fonctionne en VBA AutoCAD.
Merci de l'attention portée à mon message
--
Bernard Flavignard
Bonjour,
En VB/VBA j'ai le code suivant, après avoir mis en référence Microsoft Shell
Controls and Automation
Sub main()
Dim SH As Shell32.Shell
Dim Fldr As Shell32.Folder2
Set SH = New Shell32.Shell
Set Fldr = SH.BrowseForFolder(0, "Choisissez un répertoire", 0, "D:")
If Fldr Is Nothing Then
MsgBox "Commande annulée"
Else
MsgBox "Vous avez choisi : " & Fldr.Self.Path
End If
End Sub
Tout se passe bien mais je ne voudrais pas avoir le bouton "Créer un nouveau
dossier"
Est-ce possible?
PS : je ne peux pas utiliser les contôles DriveList et DirList de VB car mon
but est de travailler en VBA AutoCAD ou ces contrôles nexistent pas, alors que
le code ci-dessus fonctionne en VBA AutoCAD.
Merci de l'attention portée à mon message
--
Bernard Flavignard
Bonjour,
En VB/VBA j'ai le code suivant, après avoir mis en référence Microsoft Shell
Controls and Automation
Sub main()
Dim SH As Shell32.Shell
Dim Fldr As Shell32.Folder2
Set SH = New Shell32.Shell
Set Fldr = SH.BrowseForFolder(0, "Choisissez un répertoire", 0, "D:")
If Fldr Is Nothing Then
MsgBox "Commande annulée"
Else
MsgBox "Vous avez choisi : " & Fldr.Self.Path
End If
End Sub
Tout se passe bien mais je ne voudrais pas avoir le bouton "Créer un nouveau
dossier"
Est-ce possible?
PS : je ne peux pas utiliser les contôles DriveList et DirList de VB car mon
but est de travailler en VBA AutoCAD ou ces contrôles nexistent pas, alors que
le code ci-dessus fonctionne en VBA AutoCAD.
Merci de l'attention portée à mon message
--
Bernard Flavignard