Take a look at this and see if this helps

[vba]

Option Explicit

Private cnt As Long
Private arfiles As Variant
Private level As Long

Public Function Folders()
Dim i As Long
Dim sFolder As String

arfiles = Array()
cnt = 0
level = 1

sFolder = "C:\personal\bob\_reference"
ReDim arfiles(1 To 2, 1 To 1)
SelectFiles sFolder

'create a sheet to show folder structure
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(1, i) = "" Then

With .Cells(i + 1, arfiles(2, i))

.Value = arfiles(1, i)
.Font.Bold = True
End With
'End If
Next

.Columns("A:Z").ColumnWidth = 5
End With

'just in case there is another set to group

Columns("A:Z").AutoFit

End Function

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

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

cnt = cnt + 1
ReDim Preserve arfiles(1 To 2, 1 To cnt)
arfiles(1, cnt) = sPath
arfiles(2, cnt) = level

Set oFolder = FSO.GetFolder(sPath & "\")

level = level + 1
For Each oSubFolder In oFolder.Subfolders

SelectFiles oSubFolder.Path
Next
level = level - 1

End Sub
[/vba]