请问在VB中如何取得某个文件夹的大小呢？

Question

Private fsoTest As New FileSystemObject
Private folder1 As Folder
Set folder1 = fsoTest.GetFolder("d:\")
debug.print folder1.Size/1024/1024

Answer 1

要先引用Microsoft Scripting RunTime 

Answer 2

因为某种原因，服务器要关闭FileSystemObject，另外一种办法吗？

Answer 3

用Api计算。在外面dim 一个Double Totalsize
dim TotalSize as DoublePrivate Sub GetFolderSize(ByVal PathName As String)
On Error Resume NextDim SearchName As String
Dim Find_Data As WIN32_FIND_DATA
Dim lhandle As Long, ret As LongDim Filehandle As Long
Dim i As LongSearchName = PathName & "\*.*"
lhandle = FindFirstFile(SearchName, Find_Data)
ret = lhandleDo While ((ret <> 0) And Running)
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'handle the file here
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If (Find_Data.lFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> 0 Then
    
        If (Left(Find_Data.cFileName, 1) <> ".") Then        'is a directory
        'Debug.Print Pathname & "\" & TrimZeroSuffix(Find_Data.cFileName) & "\"
        Call Addfiles(PathName & "\" & TrimZeroSuffix(Find_Data.cFileName), ID)
        End If
 
    Else
    'is a file
    'handle the file here
     TotalSize =TotalSize + ConvertSize(Find_Data.nFileSizeHigh, Find_Data.nFileSizeLow)        'Debug.Print Pathname & "\" & TrimZeroSuffix(Find_Data.cFileName)
    End If
    DoEvents
    ret = FindNextFile(lhandle, Find_Data)
    CountX = CountX + 1LoopFindClose (lhandle)
End Sub

Answer 4

里面的函数有convertsize  和TrimZeroSuffix如下：Public Function ConvertSize(ByVal Highpart As Long, ByVal Lowpart As Long) As Double
Dim Result As Double
'如果溢出
If Lowpart < 0 Then
Result = Highpart * 4294967296# + 4294967296# + Lowpart
Else
Result = Highpart * 4294967296# + Lowpart
End If
ConvertSize = Result
End Function
'用来去处给定字串的C语言后缀,即'\0'字符
Public Function TrimZeroSuffix(ByVal zeroString As String) As String
Dim RetStr As String
Dim i As Integer
RetStr = ""
i = 1
Do While i <> Len(zeroString)
     If Mid(zeroString, i, 1) <> Chr(0) Then
       RetStr = RetStr & Mid(zeroString, i, 1)
    Else
       Exit Do
    End If
  i = i + 1
Loop
TrimZeroSuffix = RetStr
End Function

Answer 5

那几个API为
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As LongPublic Const MAX_PATH = 260  'Defined in stdlib.h
''''''''''''''''''''''''''''''''''''''''''
'Defined in Mapi.h
Public Const FILE_ATTRIBUTE_READONLY = 1&
Public Const FILE_ATTRIBUTE_HIDDEN = 2&
Public Const FILE_ATTRIBUTE_SYSTEM = 4&
Public Const FILE_ATTRIBUTE_DIRECTORY = 16&
Public Const FILE_ATTRIBUTE_ARCHIVE = 32&
Public Const FILE_ATTRIBUTE_NORMAL = 128&
Public Const FILE_ATTRIBUTE_TEMPORARY = 256&
''''''''''''''''''''''''''''''''''''''''''
Public Type FILETIME ' 8 Bytes
dwLowDateTime As Long
dwHighDateTime As Long
End TypePublic Type WIN32_FIND_DATA
  lFileAttributes As Long
  ftCreationTime As FILETIME
  ftLastAccessTime As FILETIME
  ftLastWriteTime As FILETIME
  nFileSizeHigh As Long
  nFileSizeLow As Long
  lReserved0 As Long
  lReserved1 As Long
  cFileName As String * MAX_PATH
  cAlternateFileName As String * 14
End Type

Answer 6

这些代码都可以重用，最大的特点是直接API操作，所以速度快，好操作。如果在VC++里，就有很多“大炮打蚊子”的代码，呵呵

Answer 7

这问题居然还没解决？！
用我的代码绝对没问题！，但要工程里引用Microsoft Scripting Runtime.

Answer 8

to donglw:
  人家已经说明原因了。    回复人：smalle(锋)　(2001-7-9 18:47:47)  得0分 
       因为某种原因，服务器要关闭FileSystemObject，另外一种办法吗？
 

Answer 9

今天我自己写了一个统计一个目录所包含的文件的总的大小的代码不需要用FSO，或者API。的代码不多几有二十多行吧Dim TotalDir(0 To 100)
Dim TotalFileSize As DoubleSub CountTotalFileSize(ByVal DirPath) '计算目录所有的文件的大小
    Dim MyPath, MyName, i As Byte, j As Byte
    If Right(DirPath, 1) <> "\" Then DirPath = DirPath & "\"    '如果尾部没斜杠就在尾部加一个斜杠
    MyName = Dir(DirPath, vbDirectory)
    
    '查找DirPath文件夹下的文件或文件夹
    '如是文件夹就把文件夹名加入数组TotalDir里面
    '否则就把其文件大小加入TotalFileSize
    Do While MyName <> ""
        If MyName <> "." And MyName <> ".." Then
            If GetAttr(DirPath & MyName) = vbDirectory Then
                For i = 0 To UBound(TotalDir, 1)
                    If TotalDir(i) = "" Then
                        TotalDir(i) = DirPath & MyName
                        Exit For
                    End If
                Next
            Else
                TotalFileSize = TotalFileSize + FileLen(DirPath & MyName)
            End If
        End If
        MyName = Dir
    Loop
    
    '把整个数组的数据向前移一位,即把刚刚查找完毕的文件夹名删除,节约资源
    For i = 0 To UBound(TotalDir, 1)
        If TotalDir(i) = "" Then
            For j = 0 To i - 1
                TotalDir(j) = TotalDir(j + 1)
            Next
            Exit For
        End If
    Next
End Sub
Function ShowDirSize(ByVal DirPath)
    For j = 0 To UBound(TotalDir, 1)
        TotalDir(j) = ""
    Next
    TotalDir(0) = DirPath
    TotalFileSize = 0
    Do While TotalDir(0) <> ""
        Call CountTotalFileSize(TotalDir(0))
    Loop
    ShowDirSize = TotalFileSize
End Function
Private Sub Command1_Click()
    Print ShowDirSize("d:\web\" & " bytes")
End Sub