Dim fso,objFolder,objSubFolders,objSubFolder
Dim file,StrCurPath,ServerPath,tmpF,fileCount
Function CreateDir(path)
If fso.FolderExists(path) Then
      Exit Function
End If
   If Not fso.FolderExists(fso.GetParentFolderName(path)) Then
      CreateDir fso.GetParentFolderName(path)   
   End If
  fso.CreateFolder(path)
End Function
Function CheckFolder(FPath)
  Set objFolder=fso.GetFolder(FPath)

For Each file In objFolder.Files
      
       If DateDiff("d",file.DateLastModified,datestr)>=1 And fso.GetExtensionName(file)="eml"then 
                  If Not fso.FolderExists(ServerPath&"\"& Mid(objFolder.Path,Len(StrCurPath)+1)) Then            
                    CreateDir ServerPath&"\"&Mid(objFolder.Path,Len(StrCurPath)+1)           
                  end if
                    file.move ServerPath&"\"&Mid(objFolder.Path,Len(StrCurPath)+1) &"\" 
           fileCount=fileCount+1
       End If
  Next 
For Each objSubFolder In objFolder.SubFolders
       CheckFolder objSubFolder
  Next
       Set objFolder=Nothing
End Function

If WScript.Arguments.Count<>0  Then
if right(wscript.arguments(0),1)<>"\" then
   msgbox "脚本参数错误，请检查!",,"备份运行提示"
   wscript.quit
end if   
Set fso = CreateObject("Scripting.FileSystemObject")
'Set objComputer = CreateObject("Shell.LocalMachine")
set objComputer=CreateObject("WSCRIPT.NETWORK")
'comName=objcomputer.MachineName
comName=objComputer.ComputerName
Set objcomputer=Nothing
datestr=DateAdd("yyyy",-1,Date())
ServerPath=wscript.arguments(0) & ComName&"\"&datestr  
StrCurPath = fso.GetParentFolderName(Wscript.ScriptFullName)
fileCount=0
CheckFolder StrCurPath
If Err Then 
   Err.Clear
   set fso=nothing
   MsgBox Err.Description & Chr(10) &"脚本参数错误，请检查，输入格式:"&Chr(10)&"\\FileServer\ShareDir\或 C:\dir\"
   WScript.Quit
End if   
if fileCount<>0 then
WScript.Echo "********* "&fileCount&" 个文件备份完成*********!"
else 
WScript.Echo "***********  没有文件需要备份!*************"
end if
WScript.Echo "备份脚本运行成功!"
Set fso=Nothing   
Else
WScript.Echo "脚本参数错误，请检查!",,"备份运行提示"
End If
复制代码