Sub Tester2()
Dim rw As Long
Dim ilevel As Long
Dim sPath As String
Dim Drive As String
Dim AnyName As String
Dim Volume As String
Dim i As Integer
Dim tot As Long
Dim sName1 As String

Drive = "H:\JAZZ\"
If Trim(Drive) = "" Then Exit Sub
If Right(Drive, 1) < "\" Then
Drive = Drive & "\"
End If
Dim sArr() As String
ReDim sArr(1 To 1)
rw = 1
ilevel = 1
'Cells(rw, ilevel) = Dir(Drive, vbVolume)
'rw = rw + 1
'Cells(rw, ilevel) = "\"
'rw = rw + 1
AnyName = Dir(Drive, vbDirectory)
Do While AnyName < ""
If AnyName < "." And AnyName < ".." _
And GetAttr(Drive & AnyName) = vbDirectory Then
sArr(UBound(sArr)) = AnyName
ReDim Preserve sArr(1 To UBound(sArr) + 1)
End If
AnyName = Dir()
Loop
ilevel = ilevel + 1
For i = 1 To UBound(sArr) - 1
AnyName = sArr(i)
sPath = Drive & AnyName & "\"
Cells(rw, ilevel) = AnyName
sName1 = Dir(sPath, vbNormal)
tot = 0
Do While sName1 < ""
tot = tot + FileLen(sPath & sName1)
sName1 = Dir()
Loop
Cells(rw, ilevel + 1) = tot
rw = rw + 1
sPath = Drive & AnyName & "\"
GetSubs sPath, rw, ilevel + 1
Next


End Sub


Sub GetSubs(sPath As String, _
rw As Long, ilevel As Long)
Dim sName As String
Dim sName1 As String
Dim i As Long
Dim sArr()
Dim sPath1 As String
Dim tot As Long
Dim rw1 As Long
ReDim sArr(1 To 1)
sName = Dir(sPath, vbDirectory)
Do While sName < ""
If sName < "." And sName < ".." Then
If GetAttr(sPath & sName) = vbDirectory Then
sArr(UBound(sArr)) = sName
ReDim Preserve sArr(1 To UBound(sArr) + 1)
End If
End If
sName = Dir()
Loop
For i = 1 To UBound(sArr) - 1
sName = sArr(i)
rw1 = rw
sPath1 = sPath & sName & "\"
Cells(rw, ilevel) = sName
sName1 = Dir(sPath1, vbNormal)
tot = 0
Do While sName1 < ""
tot = tot + FileLen(sPath1 & sName1)
sName1 = Dir()
Loop
Cells(rw, ilevel + 1) = tot
rw = rw + 1
GetSubs sPath & sName & "\", rw, ilevel + 1
Next i

End Sub

--
Regards,
Tom Ogilvy

GEORGEBEKOS wrote in message
...

TOM
i use that you sent but it scan only first level folders
can you fix it to scan at second level folders
about the size
i want the size of each folder at kb


------------------------------------------------
~~ Message posted from http://www.ExcelTip.com/
~~View and post usenet messages directly from http://www.ExcelForum.com/