' 将 c 文件夹 复制到B目录下的某日期的文件夹下 如 b\2016-7-25\c
FolderLoopCopy "C:\Users\caoya\Desktop\test1","C:\Users\caoya\Desktop\test2"
Const srcSplit = "\"
Sub FolderLoopCopy(srcF,desF)
WScript.Echo " Ready Copy Folder: " + srcF
Dim oFso,oFolder,oSubFolders,oFiles,n
Dim countSize,nowSize
n = 0 ' 操作次数
Set oFso = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFso.GetFolder(srcF)
countSize = oFolder.size+1
nowSize = 1
'生成日期文件夹
nowTime = year(Now)&"-"&Month(Now)&"-"&day(Now)&"-"&Hour(Now)&"-"&Minute(Now)&"-"&Second(Now)
exFolderName = desF + srcSplit + nowTime
Call MyCreateFolder(oFso,exFolderName)
WScript.Echo " "&n&" create folder: " + exFolderName
n = n + 1
exFolderName = exFolderName + srcSplit
Dim srcFolder
Set srcFolder = new MyFolder
srcFolder.Path = oFolder.Path
srcFolder.Name = oFolder.Name
srcFolder.exPath = exFolderName
'建立一个堆栈对象
Dim fStack,exFolderName
Set fStack = new MyStack
fStack.push srcFolder
'准备遍历堆栈
Do While fStack.Count > 0
'获取栈顶文件夹
set tempF = fStack.Pop
'WScript.Echo tempF.Path
'获取栈顶文件夹路径对象
set oFolder = oFso.GetFolder(tempF.Path)
'创建相对应文件夹
tempFolderPath = tempF.makeCopyFolderPath()
WScript.Echo " "&n&" create folder: " + tempFolderPath
n = n + 1
Call MyCreateFolder(oFso,tempFolderPath)
'获取子文件和子文件夹
set oSubFolders = oFolder.SubFolders
set oFiles = oFolder.Files
For Each oFile In oFiles
tempFileName =tempFolderPath + srcSplit + oFile.Name
nowSize = nowSize + oFile.size
WScript.Echo " "&n&" "&nowSize/countSize*100&"% create file: " + tempFileName
n = n + 1
oFile.Copy(tempFileName)
Next
For Each oSubFolder In oSubFolders
Dim tempFolder
set tempFolder = new MyFolder
tempFolder.Path = oSubFolder.Path
tempFolder.Name = oSubFolder.Name
tempFolder.exPath = tempFolderPath + srcSplit
fStack.push tempFolder
Next
Loop
Set oFolder = Nothing
Set oSubFolders = Nothing
Set oFso = Nothing
Set tempF = Nothing
WScript.Echo "Copy Folder: " + srcF + " done "
End Sub
'---------------------方便创建和复制-------------------------------
Sub MyCreateFolder(fso,folderName)
if not fso.FolderExists(folderName) Then
fso.CreateFolder(folderName)
End If
End Sub
Sub MyCopyFolder(fso,srcF,desF)
if fso.FolderExists(desF) Then
fso.CopyFolder srcF,desF
End If
End Sub
'------------------------------文件夹类-------------------------------------
Class MyFolder
Private Str_Path
Private Str_Name
Private Str_exPath '复制的路径前缀
'Property Get语句,获取属性值或对象引用,Default只与Public一起使用,表示该属性为类的默认属性
Public Property Get Path ' 完全路径
Path = Str_Path
End Property
Public Property Get Name ' 文件夹的名字
Name = Str_Name
End Property
Public Property Get exPath ' 文件夹的名字
exPath = Str_exPath
End Property
'Property Let语句,设置属性值
Public Property Let Path(New_Path)
Str_Path = New_Path
End Property
Public Property Let Name(New_Name)
Str_Name = New_Name
End Property
Public Property Let exPath(New_exPath)
Str_exPath = New_exPath
End Property
Public Sub ToString()
WScript.Echo "Path:"+Path+" Name: "+Name
End Sub
Public Function makeCopyFolderPath()
makeCopyFolderPath = exPath + Name
End Function
Public Function makeCopyFilePath(fileName)
makeCopyFilePath = exPath + Name + srcSplit + fileName
End Function
End Class
'------------------------------文件夹类-------------------------------------
'----------------------------堆栈-------------------------------------
Const MAX_STACK = 1024
Class MyStack
Public top '声明变量top
Public bottom '声明变量now
Public stack(1024) '声明堆数组
'类方法
Public Sub push(temp)
if top < MAX_STACK Then
SET stack(top) = temp
top = top + 1
Else
WScript.Echo "push(temp):stack gone max......"
End if
End Sub
Public Function pop()
if top > bottom Then
SET pop = stack(top-1)
top = top - 1
Else
pop = 0
WScript.Echo "pop():stack gone bug......"
End if
End Function
Public Function Count()
Count = top - bottom
End Function
End Class
'----------------------------堆栈-------------------------------------