VBA reads all folders and file contents in the folder and displays them in a tree structure.

Source: Internet
Author: User


Const tr_level_mark = "+"
Const tr_col_index = ""
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 'clear A2: c1000 Columns
On Error resume next
Dim shell as Variant
Set shell = Createobject ("Shell. Application ")
Set filepath = shell. browseforfolder (& O0, "select folder", & H1 + & H10, "") 'to obtain the folder path and manually select
Set shell = nothing
If filepath is nothing then ', check whether a valid path is obtained. If you cancel a program
Exit sub
Else
Gg = filepath. Items. item. Path
End if
Set OBJ = Createobject ("scripting. FileSystemObject") 'defines the variable

Call getfolders (Gg, OBJ, arrf, MF, n) 'to obtain the path

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 outputs = obj. getfolder (arrf (I ))
For each FF in logs. Files 'traverse files in the folder
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
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


'================================================ ==========================================================
'The instance used by the stack in the Tree Structure
'
'-------------------------------------------------------------------------------
'The instance provides the following functions:
'(1) in the tree structure, the total quantity is summarized by the number of levels, that is, the total quantity under the level is summarized per level.
'(2) set the Data grouping and hierarchical display of Excel in a tree structure
'(3) use the box and connection line to draw a tree, similar to the Treeview Effect
'-------------------------------------------------------------------------------
'The raw data contains all the data in the data structure. Each node has a unique number, which indicates the number of the nodes,
'Node name and quantity to be counted. The series of each branch in this tree structure is uncertain. Only
'The amount of data to be counted.
'-------------------------------------------------------------------------------
'The Code uses a dictionary object to simulate a stack, and completes statistical calculation and tree chart for one scan of the original data,
'The stack, Dictionary object, structure drawing, hierarchical display of data groups, code control cell formulas, and other aspects can be learned.
'Content.
'The example can be applied to various practices such as BOM statistics and company structure drawing.
'================================================ ==========================================================

 

Sub calculationanddrawtree ()
Dim imaxrow &, I &, J &, DIC, akeys, ilevellast %, ilevelnow %
'Restore all

Application. screenupdating = false
'Maximum row number
Imaxrow = cells (65536, 1). End (xlup). Row
'Set the Row Height
Rows ("1:" & imaxrow). rowheight = tr_row_height
'Initial level of the previous Node
Ilevellast = 0
'Set the dictionary object to simulate the stack, the key is the row number, and the item is the corresponding level. It can also be used in turn...
Set DIC = Createobject ("scripting. Dictionary ")
'Cycle from the starting row of data to the end of the Data row plus one stop, multiple rows to end the last remaining node in the stack
For I = 2 to imaxrow + 1
If I = imaxrow + 1 then
Ilevelnow = 0
Else
'Get the current node level. In this example, the number of plus signs in column B is used to judge
Ilevelnow = ubound (split (range (tr_col_level & I), tr_level_mark ))
'Sets the outline level of the current row, which does not affect the calculation of the subtotal function.
Rows (I). outlinelevel = ilevelnow
End if
'If the previous node is in the stack and the level of the previous node is the same as that of the current node, the previous node is deleted from the stack.
If DIC. exists (I-1) then
If DIC (I-1) = ilevelnow then DIC. Remove I-1
End if
'Judging the level relationship between the current node and the previous Node
If ilevelnow> ilevellast then
'The current node has a higher level than the previous node, and the current node is pushed into the stack
DIC (I) = ilevelnow
Elseif ilevelnow <ilevellast then
'The current node level is smaller than the previous node. Items in the stack that are greater than or equal to the current node level start with the top of the stack and run the content one by one.
'Get the row number array of records in the stack
Akeys = DIC. Keys
'From the top of the stack to the bottom of the stack
For J = ubound (akeys) to lbound (akeys) step-1
'If the number of records scanned is less than the current number of nodes, the system will exit the scan.
If DIC (akeys (j) <ilevelnow then exit
With range (tr_col_count & akeys (j ))
'Set the statistical formula to subtotal (9, all rows under this level). This function automatically ignores cells containing the subtotal formula in the selected area.
. Formula = "= subtotal (9," & tr_col_count & akeys (j) + 1 & ":" & tr_col_count & I-1 &")"
'Set the background color and font color
. Interior. colorindex = 33-DIC (akeys (j ))
. Font. colorindex = DIC (akeys (j) + 1
End
'Delete the project at the top of the stack
Dic. Remove akeys (j)
Next
'Press the current node into the stack.
DIC (I) = ilevelnow
End if
'Record the current node as the previous node for the next cycle
Ilevellast = ilevelnow
'Draw the current node box and draw a connection line with the parent node

Next
'Clear dictionary items and reset objects
Dic. removeall: Set DIC = nothing

Application. screenupdating = true
End sub

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.