欢迎加入我们，一同切磋技术。 &
用户名： &&&
密　码： &
共有 1411 人关注过本帖
标题：能同时选择一个或多个文件夹是个世界难题？
等　级：职业侠客
帖　子：217
专家分：367
结帖率：100%
&&已结贴√
&&问题点数：20&&回复次数：11&&&
能同时选择一个或多个文件夹是个世界难题？
搜了一下网上，以下代码可以使用于VB6和VBA（2003），但是它只能选择一个文件夹，
能同时选择多个文件夹的则还没有查到，各位高手是否做一个，本人的确需要，谢谢。
Private 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
Const BIF_RETURNONLYFSDIRS = &H1
Private pidl As Long
Private Declare Function SHGetPathFromIDList Lib &shell32.dll& Alias &SHGetPathFromIDListA& (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib &shell32.dll& Alias &SHBrowseForFolderA& (lpBrowseInfo As BROWSEINFO) As Long
Private Sub command1_Click()
Dim bi As BROWSEINFO
Dim r As Long
Dim pidl As Long
Dim path As String
Dim pos As Integer
'bi.hOwner = Me.Hwnd
'展开根目录
'bi.pidlRoot = 0&
'列表框标题
'bi.lpszTitle = &请选择软件***路径：&
'规定只能选择文件夹，其他无效
bi.ulFlags = BIF_RETURNONLYFSDIRS
'调用API函数显示列表框
pidl = SHBrowseForFolder(bi)
'利用API函数获取返回的路径
path = Space$(512)
r = SHGetPathFromIDList(ByVal pidl&, ByVal path)
pos = InStr(path, Chr$(0))
Text1 = Left(path, pos - 1)
&&MsgBox &您选择的文件夹：& & Text1
Else: Text1 = &&
搜索更多相关主题的帖子:
等　级：版主
威　望：173
帖　子：3920
专家分：24269
&&得分:10&
自己写这个框框就可以了。
这个API规定是只能选一个，当然没办法，不用这个API就是了。
1、VB提供了 LISTBOX 和 DIR命令（或控件）
2、自己生成目录列表，放到 LISTBOX 中提供选择，你选择任何个都没啥问题。
授人于鱼，不如授人于渔
早已停用QQ了
等　级：职业侠客
帖　子：217
专家分：367
回复 2楼 风吹过b
如此做法，好像是不能像一楼的代码那样自主地选择文件夹的。
等　级：版主
威　望：41
帖　子：368
专家分：2135
&&得分:10&
我不知道你的目的是什么，但在其他控件选择多个目录，不是特别复杂，如图：
代码如下：
程序代码：Private Sub Dir1_Change()
File1.path = Dir1.path
Private Sub Drive1_Change()
Dir1.path = Drive1.Drive
Private Sub File1_Click()
List1.AddItem Dir1.path
List2.AddItem Dir1.path & &\& & File1.FileName
Private Sub Form_Load()
List1.Clear
List1.Text = &&
List2.Clear
List2.Text = &&
不知道对你有没有帮助。
附件: 您没有浏览附件的权限，请
等　级：职业侠客
帖　子：217
专家分：367
回复 4楼 ZHRXJR
本人很菜，请帮忙做个附件如何？谢谢。
等　级：版主
威　望：41
帖　子：368
专家分：2135
HVB6: 你也应该说清楚一点，做个附件，没有具体要求怎么做，为你这个也花了一些时间、精力，你多打几个字就那么困难吗？
[此贴子已经被作者于 15:50编辑过]
等　级：职业侠客
帖　子：217
专家分：367
回复 6楼 ZHRXJR
附件: 您没有浏览附件的权限，请
等　级：职业侠客
帖　子：217
专家分：367
回复 6楼 ZHRXJR
1楼的要求就是选择4楼的图片的”d:\“以下一个或多个文件夹（同一级目录）。
等　级：版主
威　望：173
帖　子：3920
专家分：24269
放一个驱动器控件，一个 listbox ，一个标签控件
listbox 支持多选或复选，随你便，这里只使用掉双击事件。双击向下一层。
如果取 listbox 是否多选的条目，那自己琢磨一下。
程序代码：Option Explicit
Dim SPath As String
Const 上一层 = &..上一层&&&&&&&&&&&&&&&&'上一层的内容
Private Sub Drive1_Change()
SPath = Drive1.Drive&&&&&&&&&&&&&&&&&&&&'取驱动器
If Right(SPath, &&& SPath = SPath & &\&
Call ReReadDir&&&&&&&&&&&&&&&&&&&&&&&&&&'调用目录显示
Private Sub Form_Load()
Call Drive1_Change&&&&&&&&&&&&&&&&&&&&& '初始化时，先显示当前驱动器的
Private Sub List1_DblClick()
If List1.List(List1.ListIndex) && 上一层 Then&&&&&&&&&&&& '双击指定目录
&&& SPath = SPath & List1.List(List1.ListIndex) & &\&&&&'生成向下一层的路径
&&& Call ReReadDir&&&&&&&&&&&&&&&&&&&&& '显示
&&& SPath = Left(SPath, Len(SPath) - &&& Dim fj() As String
&&& fj = Split(SPath, &\&)&&&&&&&&&&&&&&'***
&&& fj(UBound(fj)) = &&&&&&&&&&&&&&&&&&&'取后一项去掉
&&& SPath = Join(fj, &\&)&&&&&&&&&&&&&&&'组合
&&& Call ReReadDir&&&&&&&&&&&&&&&&&&&&& '调用显示
Private Sub ReReadDir()
Dim MyName As String
List1.Clear
If Len(SPath) & MyName = Dir(SPath, vbDirectory)&&&' 找寻第一项。&&以下代码复制于 MSDN
Do While MyName && &&&&&' 开始循环。
&&&' 跳过当前的目录及上层目录。
&&&If MyName && &.& And MyName && &..& Then
&&&&&&' 使用位比较来确定 MyName 代表一目录。
&&&&&&If (GetAttr(SPath & MyName) And vbDirectory) = vbDirectory Then
&&&&&&&&&List1.AddItem MyName&&& ' 如果它是一个目录，将其名称显示出来。
&&&&&&End If
&&&MyName = Dir&&&' 查找下一个目录。
Label1.Caption = SPath&&&&&&&&& '显示当前路径
授人于鱼，不如授人于渔
早已停用QQ了
等　级：职业侠客
帖　子：217
专家分：367
回复 9楼 风吹过b
谢谢版主。已按您的要求去做，没做好。附件没法上传，不知何因。
不要误解7楼和8楼的意思。7楼和8楼的说明是个例，
文件夹的展开应象1楼一样，即人工点击后，可展开下一级文件夹。
[此贴子已经被作者于 11:17编辑过]
版权所有，并保留所有权利。
Powered by , Processed in 0.051222 second(s), 8 queries.
Copyright&, BCCN.NET, All Rights Reserved· · · · · · · · · · · ·
Copyright&
c114 All Rights Reserved
上海荧通网络信息技术有限公司版权所有
南方广告业务部: 021-51142 E-mail:
北方广告业务部: 010-33977 E-mail:shixinqi@
编辑部联系: 021-51142 E-mail:editor@服务***: 021-51142