Private Sub cmdGo_Click()
Dim varCurrentFolder As Variant
Dim sFolderName As String
Dim sFoldersInRoot() As String
Dim iStep As Integer
ReDim sFoldersInRoot(1)

sFolderName = Me.txtFolder.Text
Me.txtFolders.Text = ""

'Count all filesizes
On Error GoTo NextFile
varCurrentFolder = Dir(sFolderName, vbDirectory) ' Retrieve the first entry.
Do
If GetAttr(sFolderName & varCurrentFolder) = vbDirectory Then
If varCurrentFolder <> "" And varCurrentFolder <> ".." And varCurrentFolder <> "." Then
sFoldersInRoot(UBound(sFoldersInRoot)) = varCurrentFolder
ReDim Preserve sFoldersInRoot(UBound(sFoldersInRoot) + 1)
End If
End If
NextFile:
varCurrentFolder = Dir
Loop Until varCurrentFolder = ""

On Error GoTo Error

ReDim Preserve sFoldersInRoot(UBound(sFoldersInRoot) - 1)
For iStep = 1 To UBound(sFoldersInRoot)
'Me.lstFolders.AddItem (sFoldersInRoot(iStep) & vbTab & Traverse(sFolderName & sFoldersInRoot(iStep) & "\"))
Me.txtFolders.Text = Me.txtFolders.Text & sFoldersInRoot(iStep) & vbTab
Me.txtFolders.Text = Me.txtFolders.Text & Traverse(sFolderName & sFoldersInRoot(iStep) & "\")
Me.txtFolders.Text = Me.txtFolders.Text & Chr$(13) & Chr$(10)
Next iStep

Error:

End Sub

Dim lngFileSize As Long

Function Traverse(ByVal sFolderName) As Long
lngFileSize = 0
Call DisplayFolder2(sFolderName)
Traverse = lngFileSize
Screen.MousePointer = vbDefault
End Function

Sub DisplayFolder2(ByVal sFolderName As String)
Dim varCurrentFolder As Variant
Dim iStep As Long
Dim sFolders() As String
ReDim sFolders(1)
varCurrentFolder = Dir(sFolderName, vbDirectory) ' Retrieve the first entry.
Screen.MousePointer = vbHourglass
Do
If varCurrentFolder <> "" Then
'If it's a directory then
If GetAttr(sFolderName & varCurrentFolder) = vbDirectory Then
If varCurrentFolder <> "." And varCurrentFolder <> ".." And varCurrentFolder <> "" Then
sFolders(UBound(sFolders)) = varCurrentFolder
ReDim Preserve sFolders(UBound(sFolders) + 1)
End If
Else
'if it's a file then add the size to the list
If varCurrentFolder <> "." And varCurrentFolder <> ".." And varCurrentFolder <> "" Then
lngFileSize = lngFileSize + FileLen(sFolderName & "\" & varCurrentFolder)
End If
End If
varCurrentFolder = Dir
End If
DoEvents
Loop Until varCurrentFolder = ""

ReDim Preserve sFolders(UBound(sFolders) - 1)

For iStep = 1 To UBound(sFolders)
Call DisplayFolder2(sFolderName & sFolders(iStep) & "\")
Next iStep

End Sub
声明:本站所有文章,如无特殊说明或标注,均为本站原创发布。任何个人或组织,在未征得本站同意时,禁止复制、盗用、采集、发布本站内容到任何网站、书籍等各类媒体平台。如若本站内容侵犯了原著者的合法权益,可联系我们进行处理。