然后更新所有共享目录的size值
ly_UpdateFolderSize
End If
End Sub
Sub ly_UpdateFolderList()
On Error Resume Next
Dim lyFSO As New FileSystemObject
Dim obj1 As Object
  
    ‘建立数据连接
Set mycon =New ADODB.Connection
mycon.ConnectionString =“Provider=SQLOLEDB.1；
Password=xxxxx；Persist Security Info=True：User ID =sa；
Initial Catalog=Sizeofhome；DataSource=Tsnj004a”
mycon.Open
Dim rs1 As New ADODB.Recordset
rs1.ActiveConnection=mycon
rs1.Source= “select*from FolderParents”
rs1.LockType=adLockReadOnly
rs1.Open
Do While Not rs1.EOF
If lyFSO.FolderExists(rs1(“parentpath1”))Then
For Each obj1 In lyFSO.GetFolder(rs1(“parentpath1”))
SubFolders
Dim rs2 As New ADODB.Recordset
Dim myobjname As String
myobjname=obi1.Name
Dim mypath As String

    ‘将共享目录的绝对路径赋值给mypath变量
mypath=Trim(UCase(rs1(“parentpath1”)&“＼”& myobjname))
rs2.ActiveConnection=mycon
rs2.Source=“select * from FolderSize where folderpath1 =’“+mypath+”’”
rs2.LockType =adLockOptimistic
rs2.Open
If rs2.EOF Then
‘若表FolderSize中没有这个共享目录的记录，则添加一行新的记录
rs2.AddNew
rs2(“folderpath1”)= (UCase(rs1(“parentpath1” )& “＼”& myobjname))
‘共享目录的类型值将继承父目录的类型(类型将分为USER或DRIVE)
rs2(“type1”)=rs1(“type”)
‘对于新增加的目录记录，使enabled1开关置1，从而允许对此目录进行容量测量
rs2(“enabled1”)=1
‘对于新增加的目录记录，使forced1开关置1，从而强制对此目录进行容量测量
rs2(“forced1”)=1
‘设逻辑配额为500MB，若需更改也可通过编程方式在web页的维护界面对某个目录单独
‘修改此值
rs2(“quota1”)=500
rs2.Update
End If
rs2.Close:Set rs2 =Nothing
Next
End If
rs1.MoveNext：Loop
rs1.Close:Set rs1=Nothing
End Sub
Sub lyUpdateFolderSize()
On Error Resume Next
Dim dbl As Database
Dim rs1 As Recordset
Dim quota2,folderbytes1 As Double
Dim lyFSO As New FileSystemObject

    ‘建立数据连接
Set mycon2=New ADODB.Connection
mycon2.ConnectionString =“Provider=SQLOLEDB.1；Password=xxxxx；
Persist Security Info=True；User ID=sa；Initial Catalog=Sizeofhome；
Data Source=Tsnj004a”
mycon2.Open
Dim rs3 As New ADODB.Recordset
rs3.ActiveConnection=mycon2
rs3.Source=“select * from FolderSize where enabled1=1 or forced1=1
order by folderpath1”
rs3.LockType=adLockOptimistic
rs3.Open
Do While Not rs3.EOF

    ‘取当前系统时间
datetime1= Now ()
‘以下两种情况的共享目录需要更新：1、赋强制位：2、上次更新到现在的时间大于最
‘小时间段(即一小时，也可根据实际情况定制)
If rs3(“forced1”)=1 Or DateDiff(“h”，rs3(“datetime1”)，datetime1)> =
rs3(“minhours1”)Then
‘如果文件夹类型为DRIVE， 则采用文件系统对象的Get-Drive方法进行容量计算
If UCase(rs3(“type1”))=“DRIVE” Then
If lyFSO.DriveExists(rs3(“folderpath1”))Then rs3(“quota1”)=
lyFSO.GetDrive(rs3(“folderpath1”)).TotalSize／(1024^ 2)
rs3(“quota2”)= “MB”
rs3.Update
folderbytes1=lyFSO.GetDrive(rs3(“folderpath1”)).TotalSize -
lyFSO.GetDrive(rs3(“folderpath1”)).FreeSpace
Else
folderbytes1=-1
End If
‘如果文件夹类型为USER，则直接调用GetFolderBytes函数取容量值
Else
folderbytes 1=GetFolderBytes(rs3(“folderpath1”))
End If
If folderbytes1>=0 Then
rs3（“folderbytes1”)=folderbytes1
If rs3(“quota1”)>=0 Then
quota2 = 1
If UCase(rs3(“quota2”))= “KB” Then quota2=1024
If UCase(rs3(“quota2”))= “MB” Thenquota2 =1024^2
If UCase(rs3(“quota2”))= “GB” Thenquota2 =1024^3

    ‘通过逻辑配额计算占用百分率
rs3(“percent1”)=rs3(“folderbytes1”)／(rs3(“quota1”)*quota2)*100
Else
rs3(“percent1”)= -1
End If
rs3(“datetime1”)=datetime1
‘将计算所耗时间以秒为单位存入duration字段
rs3(“duration1”)=DateDiff(“S”，datetime1，Now())
‘强制位置0
rs3(“forced1”)=0
rs3.Update
End If
End If
rs3.MoveNext：Loop
rs3.Close
Set rs3=Nothing
End Sub
Function GetFolderBytes(mypath) As Double
On Error Resume Next
Dim lyFSO As New FileSystemObject
Dim tempValue As Double
Dimobi1 As Object
tempValue = -1
If lyFSO.FolderExists(mypath) Then tempValue=lyFSO.GetFolder(mypath).Size
IftempValue = -1 Then
tempValue =0
‘递归调用GetFolderBytes函数
For Each obj1 In lyFSO.GetFolder(mypath).SubFolders
tempValue=tempValue+GetFolderBytes(obj1.Path)
Next

    ‘计算每一级目录中文件大小的总和
For Each obj1 In lyFSO.GetFolder(mypath).Files
tempValue=tempValue+obj1.Size
Next
End If
Else
tempValue=-1
End If
GetFolderBytes=tempValue
Set lyFSO =Nothing
End Function

    将代码编译为可执行文件，并运行测试，检查SQL数据库中数据是否更新。如果确定无误，就在文件服务器的计划任务中，添加一个相隔若干时间段执行的(或每日定时执行)计划任务即可。读者可以扩展此方法， 另外建立一个基于ASP的Web应用，从而可以使管理员维护数据记录，用户也可通过网页浏览统计结果。