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