Dir

[greasybeano]

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

 

[pascalv]

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/micr...256617ef?lnk=st&rnum=4&hl=en#1b183f3d256617ef

 

[Ron de Bruin]

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

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

 

[Ardus Petus]

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

 

[greasybeano]

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

 

[greasybeano]

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

 

[Chip Pearson]

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

 

[Bob Phillips]

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]

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

 

[greasybeano]

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

 

[Chip Pearson]

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

 

[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 = "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]

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

 

[Tom Ogilvy]

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

 

[Ardus Petus]

Ooops: I forgot:
In VBE, Tools>References
tick Microsoft Scripting Runtime

HTH

 

[Tom Ogilvy]

If I change K:\ to C:\

It lists every directory in the C drive for me.

 

[Bob Phillips]

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]

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

regards

 

[Ardus Petus]

Glad I could help!

--
AP

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

regards

 

[Antonio]

Hi Bob,

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

Thanks,

Antonio