安徽彩票大奖 欧洲百万乐透大奖 七星彩17049规律大奖 双色球中大奖领奖过程 3d近期中大奖故事 广州番禺中福彩大奖的 鸡男注定会中大奖 2016江苏彩民中大奖 趣彩网大奖网黑平台 大乐透4.97亿大奖 霍邱一彩民6元中双色球547万大奖 双色球黑龙江中大奖图 体育彩票中大奖名单 什么样的人能中大奖 彩票大奖作假

VBA access 利用树形图treeview 显示本地目录结构

2017-08-29 17:46:00
Jorden
转贴:
Jorden的博客
3781

最近在做一个access数据库,要利用treeview控件,但是网上?#35757;?#30340;方法大多是基于文件结构表的,就是?#30340;?#22312;使用之前必须维护一张和目录结构一致的树状结构表,但是这?#27807;?#28155;加文件或者删除文件的时候就相当不方便,因此,经过大量尝试,终于得到一个利用DIR函数(使用方法参见msdn:http://msdn.microsoft.com/en-us/library/dk008ty4(v=VS.71)),直接从本地目录中得到结构信息,利用迭代的方法,添?#25317;絫reeview中的节点中,但这种方法中有点缺陷,现在将代码贴出,和大家分享,也希望达人们能够帮助解决这个缺陷(见代码中用红色标出的部分):

窗口上放置一个Treeview,其名字为XTree,一个imglist,名字为imglist0,treeview和imglist关联

添加主窗体的加载?#24405;?br /> Private Sub Form_Load()
On Error GoTo Err_Form_load
Dim path As String
path = CurrentProject.path
path = path & "\project_data"
Call LoadTree(xTree, path, "project_data")
Call ExpandAndShrink(3, xTree)
Exit_Form_load:
Exit Sub
Err_Form_load:
MsgBox Error
Resume Exit_Form_load
End Sub
其中调用的函数代码为:
'=================================================================================================
Function ExpandAndShrink(OptionMethod As Integer, objtree As Object)
Dim i As Integer
Select Case OptionMethod
Case 1 '展开
For i = 1 To objtree.Nodes.Count
objtree.Nodes(i).Expanded = True
Next i
Case 2 '收缩
For i = 1 To objtree.Nodes.Count
objtree.Nodes(i).Expanded = False
Next i
Case 3 '展开至二级目录
For i = 1 To objtree.Nodes.Count
objtree.Nodes(i).Expanded = False
Next i
objtree.Nodes(1).Expanded = True
End Select
End Function
'=================================================================================================
Private Function loadnodes(ByVal parentid As String, ByVal pathstr As String, ByVal objtree As Object)
On Error GoTo err_loadlist
'必须手动添加第一个基本节点,然后采用迭代的方法添加该目录下的其他文件或文件夹
'---------------------------------------------------------------------------------
Dim idstring As String
Dim myname As String
Dim index As Integer
Dim i As Integer
Dim nodCurrent As Node
pathstr = pathstr & ""
Dim nametmp As String
myname = Dir(pathstr, vbDirectory)
index = 1
Do While myname <> ""
If myname <> "." And myname <> ".." Then
If (GetAttr(pathstr & myname) And vbDirectory) = vbDirectory Then
Set nodCurrent = objtree.Nodes.Add(parentid, tvwChild, parentid & "." & index, myname, "K1", "K2")
Call loadnodes(parentid & "." & index, pathstr & myname, objtree)
'?#25317;?#24402;返回后dir()就无法从?#31995;?#22788;直?#25317;?#21040;下一个条目
'此处采用重新寻?#19994;蕉系?#20043;前的条目,然后指向下一个
'是否有更简单的方法????????
nametmp = myname
myname = Dir(pathstr, vbDirectory)
Do While myname <> nametmp
myname = Dir()
Loop
myname = Dir()
Else
Set nodCurrent = objtree.Nodes.Add(parentid, tvwChild, parentid & "." & index, myname, "K3", "K4")
myname = Dir()
End If
index = index + 1
Else
myname = Dir()
End If
Loop
'----------------------------------------------------------------------------------
exit_loadlist:
Exit Function
err_loadlist:
MsgBox Error
Resume exit_loadlist
End Function
'=================================================================================================
Function LoadTree(ByVal objtree As Object, ByVal rootpath As String, ByVal rootname As String)
On Error GoTo err_loadTree
'----------------------------------------------------------------------------
'treeview控件加载函数
'作者:zhudan [email protected]
'objtree:必填,treeview控件名
'rootpath:需要展示的目录路径
'rootname:根目录的名字,可以不和根目录名相同
'需要调用函数:loadnodes,请一起包含该函数
'----------------------------------------------------------------------------
Dim nodCurrent As Node
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
objtree.Nodes.Clear
Set nodCurrent = objtree.Nodes.Add(, , "r", rootname, "K1", "K2")
Call loadnodes("r", rootpath, objtree)
Call ExpandAndShrink(3, objtree)
'----------------------------------------------------------------------------
exit_loadTree:
Exit Function
err_loadTree:
MsgBox Error
Resume exit_loadTree
End Function


其得到的结果:


    分享
    ? 1999-2019 Office交流网?? 中山市天鸣科技发展有限公司 粤ICP备10043721号-5 SQL查询:19
    内存占用:7.75MB
    PHP 执行时间:0.21
    双色球大奖2000年
    安徽彩票大奖 欧洲百万乐透大奖 七星彩17049规律大奖 双色球中大奖领奖过程 3d近期中大奖故事 广州番禺中福彩大奖的 鸡男注定会中大奖 2016江苏彩民中大奖 趣彩网大奖网黑平台 大乐透4.97亿大奖 霍邱一彩民6元中双色球547万大奖 双色球黑龙江中大奖图 体育彩票中大奖名单 什么样的人能中大奖 彩票大奖作假