| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 3756 人关注过本帖
标题:能同时选择一个或多个文件夹是个世界难题?
只看楼主 加入收藏
HVB6
Rank: 7Rank: 7Rank: 7
等 级:贵宾
威 望:15
帖 子:331
专家分:561
注 册:2013-10-30
结帖率:98.41%
收藏
已结贴  问题点数: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
End Type
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)
If r Then
pos = InStr(path, Chr$(0))
Text1 = Left(path, pos - 1)
  MsgBox "您选择的文件夹:" & Text1
Else: Text1 = ""
End If
End Sub


搜索更多相关主题的帖子: 文件夹 网上 
2016-05-10 09:43
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:10 
自己写这个框框就可以了。
这个API规定是只能选一个,当然没办法,不用这个API就是了。
1、VB提供了 LISTBOX 和 DIR命令(或控件)
2、自己生成目录列表,放到 LISTBOX 中提供选择,你选择任何个都没啥问题。


授人于鱼,不如授人于渔
早已停用QQ了
2016-05-10 10:59
HVB6
Rank: 7Rank: 7Rank: 7
等 级:贵宾
威 望:15
帖 子:331
专家分:561
注 册:2013-10-30
收藏
得分:0 
回复 2楼 风吹过b
如此做法,好像是不能像一楼的代码那样自主地选择文件夹的。
2016-05-10 11:18
ZHRXJR
Rank: 16Rank: 16Rank: 16Rank: 16
等 级:版主
威 望:125
帖 子:1034
专家分:5519
注 册:2016-5-10
收藏
得分:10 
我不知道你的目的是什么,但在其他控件选择多个目录,不是特别复杂,如图:
图片附件: 游客没有浏览图片的权限,请 登录注册

代码如下:
程序代码:
Private Sub Dir1_Change()
File1.path = Dir1.path
End Sub

Private Sub Drive1_Change()
Dir1.path = Drive1.Drive
End Sub

Private Sub File1_Click()
List1.AddItem Dir1.path
List2.AddItem Dir1.path & "\" & File1.FileName
End Sub

Private Sub Form_Load()
List1.Clear
List1.Text = ""
List2.Clear
List2.Text = ""
End Sub

不知道对你有没有帮助。

请不要选我!!!
2016-05-10 11:25
HVB6
Rank: 7Rank: 7Rank: 7
等 级:贵宾
威 望:15
帖 子:331
专家分:561
注 册:2013-10-30
收藏
得分:0 
回复 4楼 ZHRXJR
本人很菜,请帮忙做个附件如何?谢谢。
2016-05-10 12:18
ZHRXJR
Rank: 16Rank: 16Rank: 16Rank: 16
等 级:版主
威 望:125
帖 子:1034
专家分:5519
注 册:2016-5-10
收藏
得分:0 
HVB6: 你也应该说清楚一点,做个附件,没有具体要求怎么做,为你这个也花了一些时间、精力,你多打几个字就那么困难吗?

[此贴子已经被作者于2016-5-10 15:50编辑过]


请不要选我!!!
2016-05-10 15:48
HVB6
Rank: 7Rank: 7Rank: 7
等 级:贵宾
威 望:15
帖 子:331
专家分:561
注 册:2013-10-30
收藏
得分:0 
回复 6楼 ZHRXJR
如图
图片附件: 游客没有浏览图片的权限,请 登录注册
2016-05-10 16:35
HVB6
Rank: 7Rank: 7Rank: 7
等 级:贵宾
威 望:15
帖 子:331
专家分:561
注 册:2013-10-30
收藏
得分:0 
回复 6楼 ZHRXJR
1楼的要求就是选择4楼的图片的”d:\“以下一个或多个文件夹(同一级目录)。
2016-05-10 16:57
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
放一个驱动器控件,一个 listbox ,一个标签控件

listbox 支持多选或复选,随你便,这里只使用掉双击事件。双击向下一层。
如果取 listbox 是否多选的条目,那自己琢磨一下。

程序代码:
Option Explicit

Dim SPath As String
Const 上一层 = "..上一层"               '上一层的内容

Private Sub Drive1_Change()
SPath = Drive1.Drive                    '取驱动器
If Right(SPath, 1) <> "\" Then          '组合成路径
    SPath = SPath & "\"
End If
Call ReReadDir                          '调用目录显示
End Sub

Private Sub Form_Load()
Call Drive1_Change                      '初始化时,先显示当前驱动器的
End Sub

Private Sub List1_DblClick()
If List1.List(List1.ListIndex) <> 上一层 Then             '双击指定目录
    SPath = SPath & List1.List(List1.ListIndex) & "\"   '生成向下一层的路径
    Call ReReadDir                      '显示
Else
    SPath = Left(SPath, Len(SPath) - 1) '先去掉最后的 \
    Dim fj() As String
    fj = Split(SPath, "\")              '分解
    fj(UBound(fj)) = ""                 '取后一项去掉
    SPath = Join(fj, "\")               '组合
    Call ReReadDir                      '调用显示
End If
End Sub

Private Sub ReReadDir()
Dim MyName As String
List1.Clear
If Len(SPath) > 3 Then List1.AddItem 上一层          '当前目录不为根目录时,显示上一层
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
   End If
   MyName = Dir   ' 查找下一个目录。
Loop
Label1.Caption = SPath          '显示当前路径
End Sub

授人于鱼,不如授人于渔
早已停用QQ了
2016-05-10 21:02
HVB6
Rank: 7Rank: 7Rank: 7
等 级:贵宾
威 望:15
帖 子:331
专家分:561
注 册:2013-10-30
收藏
得分:0 
回复 9楼 风吹过b
谢谢版主。已按您的要求去做,没做好。附件没法上传,不知何因。
不要误解7楼和8楼的意思。7楼和8楼的说明是个例,
文件夹的展开应象1楼一样,即人工点击后,可展开下一级文件夹。


[此贴子已经被作者于2016-5-11 11:17编辑过]

2016-05-11 11:15
快速回复:能同时选择一个或多个文件夹是个世界难题?
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.020793 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved