tagCANDY CGI VBレスキュー(花ちゃん) - ツリービューにフォルダとファイルを表示する(VB6.0) - Visual Basic 6.0 VB2005 VB2010
VB2005用トップページへVBレスキュー(花ちゃん)のトップページVB6.0用のトップページ
ツリービューにフォルダとファイルを表示する(VB6.0)
元に戻る スレッド一覧へ 記事閲覧
このページ内の検索ができます。(AND 検索や OR 検索のような複数のキーワードによる検索はできません。)

ツリービューにフォルダとファイルを表示する(VB6.0) [No.114の個別表示]
     サンプル投稿用掲示板  VB2005 〜 用トップページ  VB6.0 用 トップページ
日時: 2009/12/26 23:01
名前: 花ちゃん

***********************************************************************************
* カテゴリー:[ツリービュー][ファイル][]                                       *
* キーワード:全ファイル,サブフォルダー以下,,,,                                   *
***********************************************************************************

元質問:ツリービューにフォルダとファイルを表示す.. - kazuki  2005/11/29-01:31 No.5109

現在ブラウザを作成しているのですが、お気に入りを表示する際ツリービューでやっています。
それでツリービューにお気に入りのフォルダとurlファイルを表示させたいのですが、階層構造にさせ
ることができません。プログラムはこちらのサイト様の"指定フォルダー以下の全ファイルを列
挙"の
サンプルプログラムを参考にさせていただきました。
下にプログラムを書かせていただきますが、このプログラムを実行するとお気に入りに入っている全
てのファイルがフルパスで表示され、フォルダはまた別で表示されます。
(aaaというフォルダにbbbというurlファイルがあったらaaa\bbbとaaaという感じです)


-----------------------------------------------------------------------------------
投稿されているサンプルでは、そのままでは動作しませんので簡単なサンプルを作って
見ました。   2007/07/22
              --- by 花ちゃん ---
-----------------------------------------------------------------------------------

'使用する前に、[プロジェクト]→[参照設定]で Microsoft Scripting Runtime の参照に
'チェックを入れておいて下さい。
Option Explicit
Private Sub Command1_Click()
    Dim Fso          As FileSystemObject
    Dim TargetFolder As Folder
    Dim TargetNode   As Node
    Set Fso = New FileSystemObject
    
    TreeView1.Nodes.Clear
    '指定のフォルダ名を取得
    Set TargetFolder = Fso.GetFolder("C:\Program Files\Microsoft Visual Studio")
    '指定フォルダのフルパスを取得
    Set TargetNode = TreeView1.Nodes.Add(, , , TargetFolder)
    '指定フォルダ内のファイル及びサブフォルダを取得
    Call sFolderSearch(TreeView1, TargetNode, TargetFolder)
    TreeView1.Nodes(1).Expanded = True
    TreeView1.Nodes(2).Expanded = True
    Set Fso = Nothing
End Sub
Private Sub sFolderSearch(ByVal MyTreeView As TreeView, _
                          ByVal MyNode As Node, ByVal MyFolder As Folder)
    Dim mySubFolder As Folder
    Dim myFile      As File
    Dim ChildNode   As Node
    'サブフォルダーを取得
    For Each mySubFolder In MyFolder.SubFolders
        'フォルダーをツリー表示
        Set ChildNode = MyTreeView.Nodes.Add(MyNode, tvwChild, , mySubFolder.Name)
        'サブフォルダーがある場合再帰的に繰り返す
        Call sFolderSearch(MyTreeView, ChildNode, mySubFolder)
    Next mySubFolder
    '現在のフォルダー内のファイルを取得
    For Each myFile In MyFolder.Files
        'ファイルをツリー表示
        MyTreeView.Nodes.Add MyNode, tvwChild, , myFile.Name
    Next myFile
End Sub

----------------------------------------------------------------------------------
上記の実行結果
(画像をクリックすると元のサイズで見られます。)
メンテ

Page: 1 |

ツリービューにフォルダとファイルを表示する(VB6.0)_1  (No.1の個別表示) [スレッド一覧へ]
日時: 2010/01/10 13:12
名前: 魔界の仮面弁士

***********************************************************************************
* カテゴリー:[ツリービュー][ファイル][]                                       *
* キーワード:全ファイル,サブフォルダー以下,,,,                                   *
***********************************************************************************

列挙するフォルダ数が多いと、再帰検索に膨大な時間がかかるので、
サブフォルダの読み込み処理を遅延させることで、疑似的に高速化させてみました。

下記では、すべてのドライブを列挙してツリーを構築しています。


Option Explicit

Private Declare Function LockWindowUpdate Lib "user32" _
    (ByVal hWndLock As Long) As Long

Private FSO As Scripting.FileSystemObject
Private IncludFiles As Boolean

Private Sub Form_Initialize()
    IncludFiles = True
    Set FSO = New Scripting.FileSystemObject
End Sub

Private Sub Form_Load()
    Command1.Caption = "表示"

    TreeView1.Indentation = 360
    TreeView1.LabelEdit = tvwManual
    TreeView1.LineStyle = tvwRootLines
End Sub

Private Sub Command1_Click()
    If MsgBox("ファイルを含めますか?", vbQuestion Or vbYesNo) = vbYes Then
        BuildRootTree TreeView1, True
    Else
        BuildRootTree TreeView1, False
    End If
End Sub

Private Sub TreeView1_Expand(ByVal Node As Node)
    If CBool(Node.Tag) Then
        Exit Sub
    End If
    
    BuildSubTree TreeView1, Node
End Sub

Friend Sub BuildRootTree(ByVal tv As TreeView, ByVal IncludFiles As Boolean)
    LockWindowUpdate tv.hWnd

    tv.Nodes.Clear
    tv.Tag = IncludFiles

    Dim drv As Scripting.Drive
    Dim rootNode As Node
    For Each drv In FSO.Drives
        Set rootNode = tv.Nodes.Add(Text:=drv.path & "\")
        If drv.IsReady Then
            rootNode.Tag = False
            tv.Nodes.Add rootNode, tvwChild
        Else
            rootNode.Tag = True
        End If
    Next

    LockWindowUpdate 0
End Sub

Private Sub BuildSubTree(ByVal tv As TreeView, ByVal location As Node)
    If location Is Nothing Then
        Exit Sub
    ElseIf CBool(location.Tag) Then
        '構築済み
        Exit Sub
    End If

    LockWindowUpdate tv.hWnd

Try: On Error GoTo Finally
    location.Tag = Empty
    tv.Nodes.Remove location.Child.Index
    
    Dim path As String
    path = location.FullPath
    path = Left(path, 2) & Replace(Mid(path, 3), "\\", "\")
    
    Dim pFolder As Scripting.Folder
    Set pFolder = FSO.GetFolder(path)
    
    Dim cFolder As Scripting.Folder
    Dim cNode As Node
    Dim hasChildren As Boolean
    For Each cFolder In pFolder.SubFolders
        Set cNode = tv.Nodes.Add(location, tvwChild, , cFolder.Name)
        hasChildren = False
        On Error Resume Next
        hasChildren = CBool(cFolder.SubFolders.Count > 0)
        If hasChildren = False And CBool(tv.Tag) Then
            hasChildren = CBool(cFolder.Files.Count > 0)
        End If
        On Error GoTo Finally
        If hasChildren Then
            tv.Nodes.Add cNode, tvwChild
            cNode.Tag = False
        Else
            cNode.Tag = True
        End If
    Next

    If CBool(tv.Tag) Then
        'ファイルも列挙
        Dim cFile As Scripting.File
        For Each cFile In pFolder.Files
            tv.Nodes.Add location, tvwChild, , cFile.Name
        Next
    End If

Finally:
    If Err.Number <> 0 Then
        Debug.Print Err.Description
    End If
    location.Tag = True
    LockWindowUpdate 0
End Sub
メンテ

Page: 1 |

 投稿フォーム               スレッド一覧へ
題  名 スレッドをトップへソート
名  前
パスワード (記事メンテ時に使用)
投稿キー (投稿時 投稿キー を入力してください)
コメント

   クッキー保存   
スレッド一覧へ