在VB脚本中压缩文件

时间:2015-12-23 11:03:36

标签: vbscript

我有一个脚本,完全适合我移动文件,创建新文件夹然后删除旧文件夹,但是我无法添加压缩功能。我可以单独执行此操作,但希望在我的脚本中使用它,因为我只想运行一个计划任务。 有人可以帮忙吗?

Dim theDate, ArchiveDate
Dim CurPath
Dim BackupPath
Dim objFSO, objFolder, objFile
Dim ArchivePath


'theDate = InputBox("Date to archive (ddmmyy)")
theDate = DateAdd("d",-1, date())
dateArray = Split(theDate,"/")
theDate = dateArray(0) & dateArray(1) & Right(dateArray(2),2)

CurPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")
BackupPath = CurPath & "\" & thedate
ArchiveDate = CDate(left(theDate,2) & "/" & mid(theDate,3,2) & "/" & right(theDate,2))
ArchivePath = "E:\Log_Folder_1"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(CurPath)


'msgbox CurPath
'msgbox BackupPath
'msgbox ArchiveDate

For Each objFile In objFolder.Files
  ModifiedDate = Split(objFile.DateLastModified," ")  
  If (CDate(ModifiedDate(0)) = ArchiveDate AND objFSO.GetExtensionName(objFile) <> "vbs") Then
     'msgbox "yes " & objFile.DateLastModified
     If objFSO.FolderExists(BackupPath) = false Then
        objFSO.CreateFolder(BackupPath)
     End If
     objFile.Move BackupPath & "\" & objFile.Name
  Else
      'msgbox "no " & objFile.DateLastModified
  End If
Next


dim filesys 
set filesys=CreateObject("Scripting.FileSystemObject") 
If filesys.FolderExists(BackupPath) Then 
filesys.CopyFolder "E:\Log_Folder_1" & "\" & thedate,     "\\Backup_Server\Logs\Log_Folder_1"
End If 

If objFSO.FolderExists(CurPath & "\" & theDate) Then
    Set delFolder = objFSO.GetFolder(CurPath & "\" & theDate)
    delFolder.Delete
End If


Dim keepDays
keepDays = -20
Do Until keepDays=-10
theDate = replace(DateAdd("d",keepDays, date()),"/","")
theDate = left(theDate,4) & right(theDate,2)
If objFSO.FolderExists ("\\Backup_Server\Logs\Log_Folder_1" & "\" & theDate)     Then
  Set delFolder = objFSO.GetFolder("\\Backup_Server\Logs\Log_Folder_1" & "\" & theDate)
  delFolder.Delete
End If
keepDays=keepDays+1
Loop

0 个答案:

没有答案