Hey Guys
I hope you will help me again :)

I found this macro at Tom Ogilvys (thanks Tom).
It generates a name-list of the subfolders in the one mainfolder c:
\MyRoot\

My challenge is to make a analogous list of all the subfolders (only
the 4 caractres to the left in the subfoldername) in a selection of
mainfolders.
The selection of mainfolder is based on the beginng of foldername: "H:
\Order *\".

H:\order 2004\
H:\order 2005\
H:\order 2006\
H:\order 2007\
and so on

The final list will go like this:
0104
0204
...
1504
0105
0205
0305
....
9905
and so on.



Sub ListSubs()
Dim MyPath As String, MyName As String
Dim rw As Long


rw = 1
MyPath = "c:\MyRoot\" ' 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
Cells(rw, 1).Value = MyName ' Display entry only if it
rw = rw + 1 ' represents a directory.
End If
End If
MyName = Dir ' Get next entry.
Loop
End Sub

Do anyone feel to guide me on this one?

Best Regards Snoopy