Const TR_LEVEL_MARK = "+"
Const TR_COL_INDEX = "A"
Const TR_COL_LEVEL = "E"
Const TR_COL_NAME = "C"
Const TR_COL_COUNT = "D"
Const TR_COL_TREE_START = "F"
Const TR_ROW_HEIGHT = 23
Const TR_COL_LINE_WIDTH = 3
Const TR_COL_BOX_MARGIN = 4
Sub getpath()
Dim obj As Object, i&, arrf$(), mf&, n$(), d As Object

Range("A2:C1000").ClearContents '清空A2:C1000列
On Error Resume Next
Dim shell As Variant
Set shell = CreateObject("Shell.Application")
Set filePath = shell.BrowseForFolder(&O0, "选择文件夹", &H1 + &H10, "") '获取文件夹路径地址 手动选择
Set shell = Nothing
If filePath Is Nothing Then '检测是否获得有效路径,如取消直接跳出程序
Exit Sub
Else
gg = filePath.Items.Item.Path
End If
Set obj = CreateObject("Scripting.FileSystemObject") '定义变量

Call GetFolders(gg, obj, arrf, mf, n) '获取路径

m = -1
With ActiveSheet
For i = 1 To mf
m = m + 1
Cells(m + 1, 1) = arrf(i)
Cells(m + 1, 5) = ""
For j = 1 To n(i)
Cells(m + 1, 5) = "+" & Cells(m + 1, 5)
Level = Cells(m + 1, 5)
Next

Set fld = obj.getfolder(arrf(i))
For Each ff In fld.Files '遍历文件夹里文件
m = m + 1
Cells(m + 1, 1) = ff.Name
Cells(m + 1, 2) = ff.Path
Cells(m + 1, 3) = ff.Size
Cells(m + 1, 4) = ff.DateCreated
Cells(m + 1, 5) = Level & "+"

Next
Next
End With
Call CalculationAndDrawTree
End Sub

Private Sub GetFolders(ByVal sPath$, Fso As Object, ByRef arrf$(), ByRef mf&, ByRef n$())

Dim SubFolder As Object

mf = mf + 1
ReDim Preserve arrf(1 To mf)
arrf(mf) = sPath
ReDim Preserve n(1 To mf)
n(mf) = mf

For Each SubFolder In Fso.getfolder(sPath).SubFolders

Call GetFolders(SubFolder.Path, Fso, arrf, mf, n)

Next
Set SubFolder = Nothing
End Sub

'===============================================================================
' 堆栈在树形结构中使用的实例
'
'-------------------------------------------------------------------------------
' 本实例实现一下功能:
' (1) 树形结构中,按级数汇总数量,即每级汇总该级下全部数量
' (2) 按树形结构设置Excel的数据分组及分级显示
' (3) 使用方框与连接线绘制树形,类似TreeView效果
'-------------------------------------------------------------------------------
' 原始数据中,有全部数形结构数据,各节点唯一的编号、能指示节点所在级数的符号、
' 节点的名称、需要统计的数量。该树形结构各分支的级数不确定,仅在各分支的末梢节点有
' 待统计的数量数据。
'-------------------------------------------------------------------------------
' 本代码采用字典对象模拟堆栈,对原始数据循环一次扫描完成统计计算并绘制树形图,
' 可学习到堆栈、字典对象、结构图绘制、数据分组分级显示、代码操控单元格公式等多方面
' 内容。
' 本实例可应用于材料清单(BOM)的统计、公司结构绘制等多种实践。
'===============================================================================

Sub CalculationAndDrawTree()
Dim iMaxRow&, i&, j&, dic, aKeys, iLevelLast%, iLevelNow%
'全部恢复

Application.ScreenUpdating = False
'最大行号
iMaxRow = Cells(65536, 1).End(xlUp).Row
'设置行高
Rows("1:" & iMaxRow).RowHeight = TR_ROW_HEIGHT
'初始前一节点的级数
iLevelLast = 0
'设置字典对象以模拟堆栈,Key为行号,Item为对应的级数。也可以反过来用的...
Set dic = CreateObject("Scripting.Dictionary")
'循环自数据起始行始至数据结尾行加一止,多一行以收尾堆栈内最后剩余的节点
For i = 2 To iMaxRow + 1
If i = iMaxRow + 1 Then
iLevelNow = 0
Else
'获得当前节点级数,此例用B列加号数量判断
iLevelNow = UBound(Split(Range(TR_COL_LEVEL & i), TR_LEVEL_MARK))
'设置当前行的大纲级数,不影响SUBTOTAL函数的计算
Rows(i).OutlineLevel = iLevelNow
End If
'如果前一节点在堆栈内,且前一节点级数同当前节点,则将前一节点从堆栈内删除
If dic.exists(i - 1) Then
If dic(i - 1) = iLevelNow Then dic.Remove i - 1
End If
'判断当前节点和前一节点的级数关系
If iLevelNow > iLevelLast Then
'当前节点级数大于前一节点,将当前节点压入堆栈
dic(i) = iLevelNow
ElseIf iLevelNow < iLevelLast Then
'当前节点级数小于前一节点,将堆栈内大于等于当前节点级数的项有堆栈顶始逐一弹出,并执行内容
'获得堆栈内记录的行号数组
aKeys = dic.keys
'由堆栈顶始向堆栈底扫描
For j = UBound(aKeys) To LBound(aKeys) Step -1
'如扫描至记录的级数小于当前节点级数则退出扫描
If dic(aKeys(j)) < iLevelNow Then Exit For
With Range(TR_COL_COUNT & aKeys(j))
'设置统计公式为:SUBTOTAL(9, 该级下所有行),该函数自动忽略选中区域内含有SUBTOTAL公式的单元格
.Formula = "=SUBTOTAL(9, " & TR_COL_COUNT & aKeys(j) + 1 & ":" & TR_COL_COUNT & i - 1 & ")"
'设置背景色和字体颜色
.Interior.ColorIndex = 33 - dic(aKeys(j))
.Font.ColorIndex = dic(aKeys(j)) + 1
End With
'删除堆栈顶部项目
dic.Remove aKeys(j)
Next
'将当前节点压入堆栈
dic(i) = iLevelNow
End If
'记录当前节点为前一节点,供下一个循环使用
iLevelLast = iLevelNow
'绘制当前节点框,并与父节点绘制连接线

Next
'清空字典项并重置对象
dic.RemoveAll: Set dic = Nothing

Application.ScreenUpdating = True
End Sub

VBA读取文件夹下所有文件夹及文件内容,并以树形结构展示的更多相关文章

  1. 怎么统计指定文件夹下含有.xml格式的文件数目

    如何统计指定文件夹下含有.xml格式的文件数目?如题 ------解决思路----------------------Directory.GetFiles(@"路径", " ...

  2. C#获取文件夹下指定格式的所有文件

    C#获取文件夹下指定格式的所有文件的方法,虽然很简单,但还是分享一下吧,用到时可以稍加修改和优化就可以使用. 获取指定目录下所有文件 //最要使用 System.IO.Directory.GetFil ...

  3. Python遍历一个文件夹下有几个Excel文件及每个Excel文件有几个Sheet

    一. 解决问题: 工作中常会遇到合并Excel文件的需求,Excel文件数量不确定,里面的Sheet 数量是可变的,Sheet Name是可变的,所以,需要用到遍历一个文件夹下有几个Excel文件,判 ...

  4. java实现批量修改指定文件夹下所有后缀名的文件为另外后缀名的代码

    java实现批量修改指定文件夹下所有后缀名的文件为另外后缀名的代码 作者:Vashon package com.ywx.batchrename; import java.io.File; import ...

  5. 使用 OLEDB 及 SqlBulkCopy 将多个不在同一文件夹下的 ACCESS mdb 数据文件导入MSSQL

    注:转载请标明文章原始出处及作者信息http://www.cnblogs.com/z-huifei/p/7380388.html 前言 OLE DB 是微软的战略性的通向不同的数据源的低级应用程序接口 ...

  6. Windows操作系统单文件夹下到底能存放多少文件及单文件的最大容量

    本文是转自:http://hi.baidu.com/aqgjoypubihoqxr/item/c896921f8c2eaba5feded5f2         最近需要了解Windows中单个文件夹下 ...

  7. tomcat的bin文件夹下的.bat和.sh文件

    tomcat的bin文件夹中存在一份.bat文件和相对应的.sh文件,一个是为了在window系统上执行的文件,另一个是linux下的批处理文件.例如:startup.bat和startup.sh. ...

  8. ubuntu18.04 复制或剪切某文件夹下的前x个文件到另一个文件夹下

    该代码可以将file_path_src文件夹中的前cnt个文件,剪切或复制到file_path_tar文件夹下,前提是file_path_src中的文件名可以排序.如VOC数据集提取某个类的图片和xm ...

  9. Java获取Linux上指定文件夹下所有第一级子文件夹

    说明:需要只获得第一级文件夹目录 package com.sunsheen.jfids.studio.monitor.utils; import java.io.BufferedReader; imp ...

随机推荐

  1. 49个jquery代码经典片段

    49个jquery代码经典片段,这些代码能够给你的javascript项目提供帮助.其中的一些代码段是从jQuery1.4.2才开始支持的做法,另一些则是真正有用的函数或方法,他们能够帮助你又快又好地 ...

  2. 初始Hibernate框架技术

    hibernate: 定义:ORM:Object Relational Mapping 对象 关系 映射 使用hibernate时几个必要的: 1.实体类 2.映射文件(类  -数据库表,属性-字段) ...

  3. RTMP命令亲自测试记录

    手动和自动录像模块: recorder rec1 { record all manual; record_unique on; record_notify on; record_max_size 51 ...

  4. Doragon Kuesuto 1.15

    #include<stdio.h> #include<stdlib.h> #include<time.h> int main() { ; ; ; int actio ...

  5. JSP的隐式对象

    JSP支持九个自动定义的变量,江湖人称隐含对象.这九个隐含对象的简介见下表: 参考资料:http://www.runoob.com/jsp/jsp-syntax.html

  6. Python学习笔记3—字符串

    原始字符串 使用\转义或者r,这种方法在网站设置网站目录结构的时候非常管用. >>> dos="c:\news" >>> print dos c ...

  7. HTML的<body>标签详解与HTML常用的控制标记

    一.<body>标签: 用于标记网页的主体,body 元素包含文档的所有内容(比如文本.超链接.图像.表格和列表等等.) 1.body标签中可用的属性: bgcolor="颜色值 ...

  8. 线程池的原理及实现 (zhuan)

    http://blog.csdn.net/hsuxu/article/details/8985931 ************************************************* ...

  9. 本地获取System权限CMD方法汇总(转)

    本地获取System权限CMD方法汇总(转) 稍微整理了下,大概有三种方法可以本地获取system权限的cmd,但前提都是当前用户具备administrator权限. 下面列举的三种方法各有千秋,看你 ...

  10. scp lost connection

    将本机的文件copy到远程时, scp -r /home/Projects/test.rpm root@172.1.1.1:/root; 我们得到了一个错误:lost connection lost ...