查看完整版本: 学习中，恳请帮忙！

学习中，恳请帮忙！

我有一段代码是删除文件夹sh001下两天之前的文件夹，如果改成删除d:\createxi下所有以sh开头的文件夹下2天之前的文件夹要怎么修改呢？恳请知道的帮个忙指点一下。P.JU,^*b6U
Dim i, fso, f, f1, sf, BasePath, CalcResult, fNameArray();^
i;ee6JT
BasePath = "D:\create\sh001"\D0kAFxX.F
Set fso = CreateObject("Scripting.FileSystemObject")2N t
]6A o+^h&A
Set f = fso.GetFolder(BasePath)
{$}:q } F|t'A G"v/t Set sf = f.SubFoldersr)A0H$S6l'J
For Each f1 in sf"|w4Ko i!?v
     CalcResult = DateDiff("d",f1.DateCreated,Now)'b$q}Il|
          if CalcResult > 2 then
BW(g'fM;L                 ReDim preserve fNameArray(i)3l9t&pd2cq4J8x^
                fNameArray(i) = f1.Name
'[mw hP                 i = i + 1
YMf$Zq2y7d         end if)ojO1WNm
Next
y4p#g{%w1M$W For Each fName in fNameArrayx_BYm w4[)X
    FSO.DeleteFolder(BasePath & "\" & fName)
O;eG#T*Q Next;u'\o*fiS0N9a)id+e
E rm.HEi+yx
q
[[i] 本帖最后由 北羊 于 2008-4-24 21:10 编辑 [/i]]

主程验证文件夹名,符合要求就执行子程序
Mlo[V5Lk 子程序就是你写的那个了[code]Dim i, fso, f, f1, sf, BasePath, CalcResult, fNameArray()
#G(G3Q9t^l1M {fuh*cDx
BasePath = "D:\create\sh001"
@%RD0L:Q/\R Set fso = CreateObject("Scripting.FileSystemObject")
(Aj|GCVy] T T Set f = fso.GetFolder(BasePath)
&f%`p
m
q4q Set sf = f.SubFoldersT)OI+J*t(c|~g:|
g.C/Z%Q9m
WccB
For Each f1 in sf
_+@f&Tg l1H9J           if f1.name ="^sh\S*" then          '此处的正则表达式我不保证正确,对这东西刚开始学习,呵呵,见笑4|6z2QFh$iS+i+s
                clear(f1)i E(\\z*}cM;?%\&SU
        end if
k5b{;r ^B Next
gl5sP [*j{e LRU$KE5|^(O S5G:C
'W7U"x!A!|E"KQ,P@2T
Function clear(subfolder)6bx'FOI#Dt
这里的内容跟你那个一样
S/{7dE5c,OR+G End Function[/code]

我也来学习