office交流網(wǎng)--QQ交流群號及微信交流群

Access培訓群：792054000         Excel免費交流群群：686050929          Outlook交流群：221378704    

Word交流群：218156588             PPT交流群：324131555

微信交流群（請用微信掃碼)

        

VBA access 利用樹形圖treeview 顯示本地目錄結(jié)構(gòu)

2017-08-29 17:46:00
Jorden
轉(zhuǎn)貼：
Jorden的博客
12502

最近在做一個access數(shù)據(jù)庫，要利用treeview控件，但是網(wǎng)上搜到的方法大多是基于文件結(jié)構(gòu)表的，就是說你在使用之前必須維護一張和目錄結(jié)構(gòu)一致的樹狀結(jié)構(gòu)表，但是這使得添加文件或者刪除文件的時候就相當不方便，因此，經(jīng)過大量嘗試，終于得到一個利用DIR函數(shù)（使用方法參見msdn：http://msdn.microsoft.com/en-us/library/dk008ty4(v=VS.71)），直接從本地目錄中得到結(jié)構(gòu)信息，利用迭代的方法，添加到treeview中的節(jié)點中，但這種方法中有點缺陷，現(xiàn)在將代碼貼出，和大家分享，也希望達人們能夠幫助解決這個缺陷（見代碼中用紅色標出的部分）：

窗口上放置一個Treeview，其名字為XTree，一個imglist，名字為imglist0，treeview和imglist關(guān)聯(lián)

添加主窗體的加載事件：
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
其中調(diào)用的函數(shù)代碼為：
'=================================================================================================
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
'必須手動添加第一個基本節(jié)點，然后采用迭代的方法添加該目錄下的其他文件或文件夾
'---------------------------------------------------------------------------------
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)
'從遞歸返回后dir()就無法從斷點處直接得到下一個條目
'此處采用重新尋找到斷點之前的條目，然后指向下一個
'是否有更簡單的方法？？？？？？？？
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控件加載函數(shù)
'作者:zhudan zhudan_02@yahoo.cn
'objtree：必填，treeview控件名
'rootpath：需要展示的目錄路徑
'rootname：根目錄的名字，可以不和根目錄名相同
'需要調(diào)用函數(shù)：loadnodes，請一起包含該函數(shù)
'----------------------------------------------------------------------------
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


其得到的結(jié)果：


    分享
    文章分類
    聯(lián)系我們
    聯(lián)系人： 王先生
    Email： 18449932@qq.com
    QQ： 18449932
    微博： officecn01
    移動訪問