Dir
 

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

Dir
 

On Sat, 27 May 2006, greasybeano wrote:

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?

You may be interested by Application.FileSearch
and fs.GetFolder(folderName)
where fs is a FileSystemObject

http://groups.google.com/group/micro...3f3d25661 7ef

Dir
 

See
http://www.rondebruin.nl/copy3.htm

And then click on this link
http://www.rondebruin.nl/fso.htm

--
Regards Ron de Bruin
http://www.rondebruin.nl


"greasybeano" wrote in message ...
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

Dir
 

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

Dir
 

thanks for reply but could not see anything from link provided that would
assist me.
--
GB


" wrote:

On Sat, 27 May 2006, greasybeano wrote:

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?

You may be interested by Application.FileSearch
and fs.GetFolder(folderName)
where fs is a FileSystemObject

http://groups.google.com/group/micro...3f3d25661 7ef

Dir
 

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

Dir
 

If all you need is the top subdirectories, not all directories,
use


Dim FSO As Object
Dim Fldr As Object
Dim SubFldr As Object
Dim Rng As Range
Set Rng = Range("A1")

Set FSO = CreateObject("Scripting.FileSystemObject")
Set Fldr = FSO.getfolder("C:\")
For Each SubFldr In Fldr.subfolders
Rng.Value = SubFldr.Path
Set Rng = Rng(2, 1)
Next SubFldr



--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com


"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

Dir
 

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

Dir
 

chip thanks for you kind assistance - code good but want print a list all the
directories associated with each top level directory - sorry if did not make
that clear.

regards
--
GB


"Chip Pearson" wrote:

If all you need is the top subdirectories, not all directories,
use


Dim FSO As Object
Dim Fldr As Object
Dim SubFldr As Object
Dim Rng As Range
Set Rng = Range("A1")

Set FSO = CreateObject("Scripting.FileSystemObject")
Set Fldr = FSO.getfolder("C:\")
For Each SubFldr In Fldr.subfolders
Rng.Value = SubFldr.Path
Set Rng = Rng(2, 1)
Next SubFldr



--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com


"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

Dir
 

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

Dir
 

Try

Sub StartHere()
Dim FF As Object
Dim FSO As Object
Dim Rng As Range
Set Rng = Range("a1") '<< CHANGE IF REQUIRED
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FF = FSO.GetFolder("C:") ' << CHANGE IF REQUIRED

DoFolder FF, Rng
End Sub

Sub DoFolder(F As Scripting.Folder, Rng As Range)
Dim FF As Object
Rng.Value = F.Path
Set Rng = Rng(2, 1)
For Each FF In F.SubFolders
DoFolder FF, Rng
Next FF
End Sub



--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com

"greasybeano" wrote in message
...
chip thanks for you kind assistance - code good but want print
a list all the
directories associated with each top level directory - sorry if
did not make
that clear.

regards
--
GB


"Chip Pearson" wrote:

If all you need is the top subdirectories, not all
directories,
use


Dim FSO As Object
Dim Fldr As Object
Dim SubFldr As Object
Dim Rng As Range
Set Rng = Range("A1")

Set FSO = CreateObject("Scripting.FileSystemObject")
Set Fldr = FSO.getfolder("C:\")
For Each SubFldr In Fldr.subfolders
Rng.Value = SubFldr.Path
Set Rng = Rng(2, 1)
Next SubFldr



--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com


"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

Dir
 

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

Dir
 

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

Dir
 

I think he meant this:

Public Sub test2()


Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
ActiveCell.Formula = nbFiles("C:\users", fs)


End Sub


Private Function nbFiless(folderName As String, ByRef fs As Object)


Dim f As Object


nbFiles = fs.GetFolder(folderName).Files.Count


If Not (fs Is Nothing) Then
If fs.GetFolder(folderName).SubFolders.Count 0 Then
For Each f In fs.GetFolder(folderName).SubFolders
nbFiles = nbFiles _
+ nbFiles(f.Path, fs)
Next
End If
End If
End Function




--
Regards,
Tom Ogilvy

"greasybeano" wrote in message
...
thanks for reply but could not see anything from link provided that would
assist me.
--
GB


" wrote:

On Sat, 27 May 2006, greasybeano wrote:

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?

You may be interested by Application.FileSearch
and fs.GetFolder(folderName)
where fs is a FileSystemObject


http://groups.google.com/group/micro...3f3d25661 7ef

Dir
 

Ooops: I forgot:
In VBE, ToolsReferences
tick Microsoft Scripting Runtime

HTH
--
AP

"greasybeano" a écrit dans le message de
news: ...
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

Dir
 

If I change K:\ to C:\

It lists every directory in the C drive for me.

--
Regards,
Tom Ogilvy

"greasybeano" wrote in message
...
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

Dir
 

The complexity is mainly due to the formatting that I apply to the list of
folders, the main code is relatively simple.

It does work as Tom verified, so you need to check what you did.

--
HTH

Bob Phillips

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

"greasybeano" wrote in message
...
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

Dir
 

it was that simple! works as intended! many thanks to you all.

regards
--
GB


"Ardus Petus" wrote:

Ooops: I forgot:
In VBE, ToolsReferences
tick Microsoft Scripting Runtime

HTH
--
AP

"greasybeano" a écrit dans le message de
news: ...
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

Dir
 

Glad I could help!

--
AP

"greasybeano" a écrit dans le message de
news: ...
it was that simple! works as intended! many thanks to you all.

regards
--
GB


"Ardus Petus" wrote:

Ooops: I forgot:
In VBE, ToolsReferences
tick Microsoft Scripting Runtime

HTH
--
AP

"greasybeano" a écrit dans le message de
news: ...
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

Dir
 

Hi Bob,

I take my hat off. This piece of code is high quality.

Thanks,

Antonio

"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

Dir
 

It's better in its full version Antonio, I include the files in that and
hyperlink them

Bob

"Antonio" wrote in message
...
Hi Bob,

I take my hat off. This piece of code is high quality.

Thanks,

Antonio

"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