Bob - many many thanks for doing this for me but I did not realise this would
be so complicated! - despite your kind efforts - I am still only getting the
tope level directories - Am I doing something wrong?

As a thought - if I just wanted a to search for a single folder in "C\"
which may or may not have files contained in it - would that approach be
easier?

Again - many thanks to all for your assistance - very much appreciated.

Regards
--
GB


"Bob Phillips" wrote:

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 = "K:\"
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


--
HTH

Bob Phillips

(replace somewhere in email address with googlemail if mailing direct)

"greasybeano" wrote in message
...
Bob thanks tried like your solution but still just getting 1st level
directory?

Hope that I made clear what i am trying to achieve - for each top level
folder, I want to print out all associated subfolders but I having some
difficulty do this. Some solutions kindly offered by others may work but
my
VB is limited where some adapting is required.

regards
--
GB


"Bob Phillips" wrote:

Try this variation on Ardus's code

Sub Finddir()
Dim FSO As Object
Dim fDir As Object
Dim fSubDir As Object
Dim i As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
Set fDir = FSO.GetFolder("C:\")
For Each fSubDir In fDir.SubFolders
i = i + 1
Cells(i, "A").Value = fSubDir.Name
Next fSubDir
End Sub



--
HTH

Bob Phillips

(replace somewhere in email address with googlemail if mailing direct)

"greasybeano" wrote in message
...
thanks for all who replied however, still not too clear what i need to
do
(my
VB tad limited) I tried sample code provided by Ardus but get Error
"user-defined type not defined" Ron's solution looks the business but
again
not too sure how I would adapt it for my need.
I just need to show all the sub folders (from "C\" ) associated to
each
first level directory. these folders may or may not contain any
files - I
should mention i am using xl2003.

many thanks

--
GB


"Ardus Petus" wrote:

Dim fso As Scripting.FileSystemObject

Sub test()
Set fso = New Scripting.FileSystemObject
Finddir ("c:\")
End Sub

Sub Finddir(MyPath As String)
Dim fDir As Folder
Dim fSubDir As Folder
Set fDir = fso.GetFolder(MyPath)
Debug.Print fDir.Path
For Each fSubDir In fDir.SubFolders
Finddir fSubDir.Path
Next fSubDir
End Sub

HTH
--
AP

"greasybeano" a écrit dans le
message
de
news: ...
I have taken the following code from the Dir help file which works
ok
at
first level.
However, I need to search for all the associated subdirectories
but
not
too
sure how to adapt the code. could someone be kind enough to assist
please?
Many thanks.
--
GB

Sub Finddir()
MyPath = "c:\" ' Set the path.
myname = Dir(MyPath, vbDirectory) ' Retrieve the first entry.
Do While myname < "" ' Start the loop.
' Ignore the current directory and the encompassing directory.
If myname < "." And myname < ".." Then
' Use bitwise comparison to make sure MyName is a
directory.
If (GetAttr(MyPath & myname) And vbDirectory) = vbDirectory
Then
Debug.Print myname ' Display entry only if it ' it
represents
a directory.
End If
End If
myname = Dir ' Get next entry.
Loop
End Sub