View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Tom Ogilvy Tom Ogilvy is offline
external usenet poster
 
Posts: 27,285
Default Map/List of folders, subfolders & files

This was previously posted by Bob Phillips:

Option Explicit

Private cnt As Long
Private arfiles
Private level As Long


Sub Folders()
Dim i As Long
Dim sFolder As String
Dim iStart As Long
Dim iEnd As Long
Dim fOutline As Boolean


arfiles = Array()
cnt = -1
level = 1


sFolder = "C:\"
ReDim arfiles(2, 0)
If sFolder < "" Then
SelectFiles sFolder
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Files").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Worksheets.Add.Name = "Files"
With ActiveSheet
For i = LBound(arfiles, 2) To UBound(arfiles, 2)
If arfiles(0, i) = "" Then
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If
With .Cells(i + 1, arfiles(2, i))
.Value = arfiles(1, i)
.Font.Bold = True
End With
iStart = i + 1
iEnd = iStart
fOutline = False
End If
Next
.Columns("A:Z").ColumnWidth = 5
End With
End If
'just in case there is another set to group
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If


Columns("A:Z").ColumnWidth = 5
ActiveSheet.Outline.ShowLevels RowLevels:=1
ActiveWindow.DisplayGridlines = False


End Sub


'-----------------------------------------------------------------------
Sub SelectFiles(Optional sPath As String)
'-----------------------------------------------------------------------
Static FSO As Object
Dim oSubFolder As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim arPath


If FSO Is Nothing Then
Set FSO = CreateObject("Scripting.FileSystemObject")
End If


If sPath = "" Then
sPath = CurDir
End If


arPath = Split(sPath, "\")
cnt = cnt + 1
ReDim Preserve arfiles(2, cnt)
arfiles(0, cnt) = ""
arfiles(1, cnt) = arPath(level - 1)
arfiles(2, cnt) = level


Set oFolder = FSO.GetFolder(sPath)


level = level + 1
If Not sPath Like "*System Volume Information*" Then
For Each oSubFolder In oFolder.subfolders
SelectFiles oSubFolder.Path
Next
End If
level = level - 1


End Sub


--
Regards,
Tom Ogilvy


"Bogdan" wrote in message
...
Hi there,

I'd like to create a VBA code, which should generate the map of all

folders
and subfolders (and their subfolders and so on) of a particular folder,

say
C:\.

The case is like this: I have a folder containing more than 100

subfolders.
Each subfolder also contains a variable number of subfolders (from 1 to

20)
and so on. The thing is that the total number of folders and subfolders is
huge and I have to keep them under control.

Can anybody help me?

Thanking in advance,

Bogdan