Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Excel 2007 Auto-Outline Difficulty

Status
Not open for further replies.

MasterRacker

New member
Oct 13, 1999
3,343
0
0
US
I am trying to analyze a large folder tree to simplify the security setup. I dumped a TREE /A output into a text file then into Excel to get the folder listing. It then wrote a crude string parsing routine to determine where the '+' and '\' characters were and output the nesting level of the folder. This has left me with a column of levels. It looks something like this:
[tt]
LEVEL FOLDER
1 +---TopFolderA
2 | +---SubFolderA
3 | | +---Folder1
3 | | +---Folder2
3 | | \---Folder3
2 | +---SubFolderB
2 | +---SubFolderC
3 | | +---Folder1
3 | | \---Folder2
2 | +---SubFolderD
3 | | +---Folder1
[/tt]
I want to outline this structure so I can expand and contract different levels similar to the way you can in Windows Explorer. When I try to perform and Auto-outline I get the message: "Cannot create an outline".

The full list is over 7600 rows so manually creating all the groups is not going to happen. How might I get auto-outline to work with this structure?

_____
Jeff
[small][purple]It's never too early to begin preparing for [/purple]International Talk Like a Pirate Day
"The software I buy sucks, The software I write sucks. It's time to give up and have a beer..." - Me[/small]
 
Here is something I wrote recently thats does pretty much what you want. The problem is with Auto-Group you can only have 8 levels of grouping.

The program reads through the folders and sub folders of a given folder then puts it in Excel. Once in Excel the files are broken down in to a collapsible groups.

Code:
'********************************************************************************
'********************************************************************************
'***  This program reads all the folders and sub folders on a selected drive  ***
'***  then puts them into an Excel Sheet and groups the folders into a        ***
'***  collapsible group.                                                      ***
'***                                                                          ***
'***  Written By Paul Found                                17th Febuary 2008  ***
'********************************************************************************
'********************************************************************************

'**********************************
'Declare FSO as a FileSystemObject
'**********************************
Public FSO As Scripting.FileSystemObject
Sub RunAll()
GetAllFolder
FormatPage
GroupFileNames
Range("A1").Select
End Sub

Sub GetAllFolder() 'Sub routine to get file names
'******************
'Declare Variables
'******************
Dim MainFolderName As String
Dim drv As Drives
Dim DriveName() As String
Dim arrCount As Integer

'*********************************************
'Sets the FileSystemObject and Drive variable
'*********************************************
Set FSO = New Scripting.FileSystemObject
Set drv = FSO.Drives

arrCount = 1

'*********************************
'Put all drive names into a array
'*********************************
For Each d In drv
    ReDim Preserve DriveName(arrCount)
    strText = d.DriveLetter & ":\"
    DriveName(arrCount - 1) = strText
    arrCount = arrCount + 1
Next d

'********************************************************
'Build the options into a text string for the input box
'********************************************************
For i = 0 To UBound(DriveName()) - 1
    InputText = InputText & i & " - Drive: " & DriveName(i) & Chr(13)
Next i
MainFolderName = InputBox("Choose a Drive number from the list below." & Chr(13) & _
                        InputText, "Drive Number", 0)
                        
'**************************************************
'Pass the drive name to the GetSubFolder procedure
'**************************************************
GetSubFolder DriveName(MainFolderName)
Set FSO = Nothing
End Sub

Sub GetSubFolder(MainFolderName As String)
'******************
'Declare Variables
'******************
Dim MainFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim r As Long

Set MainFolder = FSO.GetFolder(MainFolderName)
On Error Resume Next
'**********************************
'Find the next available empty row
'**********************************
r = Range("A65536").End(xlUp).Row + 1


'****************************
'Put the Source name in cell
'****************************
Cells(r, 1).Formula = MainFolderName
r = r + 1

'***************************************
'Run this procedure for each sub folder
'***************************************
For Each SubFolder In MainFolder.SubFolders
    GetSubFolder SubFolder.Path
Next SubFolder
    
Columns("A:H").AutoFit
Set MainFolder = Nothing
End Sub

Sub FormatPage() 'Format the list of folders
Dim ColCount, UsedCol As Integer

'***************************************************************************************
'Split the folders and Sub Folders into diffrent coloumns using the \ as the delimeter
'***************************************************************************************
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
    :="\", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), _
    TrailingMinusNumbers:=True
Cells.EntireColumn.AutoFit

'*****************************************
'Counts the rows and columns of the table
'*****************************************
Range("A1").Select
ColCount = Selection.CurrentRegion.Columns.Count
RowCount = Selection.CurrentRegion.Rows.Count

'set the sheet to all white background
With Cells.Interior
        .ColorIndex = 2
        .Pattern = xlSolid
End With

'****************************
'Put a title and format text
'****************************
If ColCount > 7 Then
    UsedCol = 7
    With Range(Cells(1, 8), Cells(1, ColCount))
        .Merge
        With .Font
            .Bold = True
            .Size = 10
            .Name = "Tahoma"
            .ColorIndex = 0
        End With
        .Value = "Not Included In Grouping"
        .HorizontalAlignment = xlLeft
        .ColumnWidth = 12
    End With
    With Range(Cells(1, 8), Cells(RowCount, ColCount)).Interior
        .ColorIndex = 36
        .Pattern = xlSolid
    End With
Else
    UsedCol = ColCount
End If

With Range(Cells(1, 1), Cells(1, UsedCol))
    .Merge
    With .Font
        .Bold = True
        .Size = 14
        .Name = "Tahoma"
        .ColorIndex = 2
    End With
    With .Interior
        .ColorIndex = 5
        .Pattern = xlSolid
    End With
    .Value = "Pauls File List"
    .HorizontalAlignment = xlLeft
End With

With Range(Cells(1, 1), Cells(RowCount, UsedCol)).Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With

With Range(Cells(1, 1), Cells(RowCount, UsedCol)).Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = 15
End With

End Sub

Sub GroupFileNames() 'Group the folders into a collapsible table
Dim intRow, intCol As Integer
Dim GroupName As String
Dim StartRow As Integer

Set xls = ActiveWorkbook.Worksheets("Sheet1")

StartRow = 2
intRow = 2
intCol = 1

Do While WorksheetFunction.CountBlank(xls.Range(Cells(1, intCol), Cells(65536, intCol))) < 65536 And intCol <= 7
    Do While xls.Range("A" & intRow) <> ""
        GroupName = xls.Cells(StartRow, intCol)
        If GroupName = "" Then GoTo PassGroup:
        Do While xls.Cells(intRow, intCol) = GroupName
            intRow = intRow + 1
        Loop
    
        If xls.Cells(intRow, intCol) <> GroupName Then
            intRow = intRow - 1
        End If
    
        If intRow > StartRow Then
            xls.Range(Cells(StartRow + 1, intCol), Cells(intRow, intCol)).Select
            Selection.Rows.Group
        End If
PassGroup:
        intRow = intRow + 1
        StartRow = intRow
    Loop
    StartRow = 2
    intRow = 2
    intCol = intCol + 1
Loop
Set xls = Nothing
Set StartRange = Nothing
End Sub
 



I believe that the way that outline works, your data must be reformatted like...
[tt]
TopFolderA
TopFolderA SubFolderA
TopFolderA SubFolderA Folder1
TopFolderA SubFolderA Folder2
TopFolderA SubFolderA Folder3
TopFolderA SubFolderB
TopFolderA SubFolderC
TopFolderA SubFolderC Folder1
TopFolderA SubFolderC Folder2
TopFolderA SubFolderD
TopFolderA SubFolderD Folder1
[/tt]

Skip,
[sub]
[glasses]Have you heard that the roundest knight at King Arthur's round table was...
Sir Cumference![tongue][/sub]
 



MasterRacker,

Did your issue get resolved?

Skip,
[sub]
[glasses]Have you heard that the roundest knight at King Arthur's round table was...
Sir Cumference![tongue][/sub]
 
Sorry - Actually I did.

I didn't want to put much more work into the auto-outline since this was a one-off project. I was simply trying to visualize how folder security was set up in the whole tree to clean it up.

I ended up using filtering (show 1, show 1&2, etc.) to simulate collapsing and combined that with some color coding. It was enough to get me where I needed to be.

I think you structure would have worked, but it would have taken a lot to rearrange the data that way.

_____
Jeff
[small][purple]It's never too early to begin preparing for [/purple]International Talk Like a Pirate Day
"The software I buy sucks, The software I write sucks. It's time to give up and have a beer..." - Me[/small]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top