压缩大文件夹失败

时间:2014-02-25 22:47:26

标签: vbscript

我正在尝试存档日志以捕获我的日志被定期覆盖的间歇性故障。我希望存档日志以确保我捕获所需的事件。

我已经编写了执行此操作的功能代码,但是如果文件夹非常大,则zip会失败。如果我将它指向一个较小的目录,它可以正常工作。 没有产生任何错误,我很感激在确定原因方面提供任何帮助。

由于我以前从未在VBS编程过,如果这似乎是一个简单的问题,我会事先道歉。

Option Explicit 
dim objFSO, objFolder, FolderToZip, ziptoFile 
dim ShellApp, eFile, oNewZip, strZipHeader 
dim ZipName, Folder, i, Zip 
Set objFSO = CreateObject("Scripting.FileSystemObject") 
Set objFolder = objFSO.GetFolder("D:\Program Files\afolder") 


Wscript.Sleep 2000 
Set oNewZip = objFSO.OpenTextFile("C:\Archive\logs_" & day(date) & month(Date) & Year(date)& ".zip", 8, True) 
strZipHeader = "PK" & Chr(5) & Chr(6) 
For i = 0 to 17 
 strZipHeader = strZipHeader & Chr(0) 
Next 
oNewZip.Write strZipHeader 
oNewZip.Close 
Set oNewZip = Nothing 
WScript.Sleep 5000 

FolderToZip = "D:\Program Files\afolder" 
ZipToFile = "C:\Archive\logs_" & day(date) & month(Date) & Year(date)& ".zip"
Set ShellApp = CreateObject("Shell.Application") 
Set Zip= ShellApp.NameSpace(ZipToFile) 
Set Folder= ShellApp.NameSpace(FolderToZip) 
Zip.CopyHere(FolderToZip) 
WScript.Sleep 2000 

1 个答案:

答案 0 :(得分:4)

你的代码比它需要的复杂一点,但它原则上有效。导致大文件夹遇到的失败的原因是最后固定的2秒延迟:

WScript.Sleep 2000

CopyHere以异步方式运行,这意味着它在脚本继续运行时在后台运行。但是,延迟2秒后脚本终止(以及Shell.Application实例),无论CopyHere是否已完成。当您有大量/大文件时,处理可能需要2秒以上。

这就是为什么你的脚本适用于小文件夹,但不适用于大文件夹。当脚本在2秒后终止时,复制工作就完成了。

要避免这种情况,请使用将已处理文件数与总文件数进行比较的检查替换固定延迟:

Set fso = CreateObject("Scripting.FileSystemObject")
Set app = CreateObject("Shell.Application")

zipfile = "C:\Temp\logs_" & Day(Date) & Month(Date) & Year(Date) & ".zip"
fldr    = "C:\Temp\sample"
cnt     = fso.GetFolder(fldr).Files.Count

'create a new empty zip file
fso.OpenTextFile(zipfile, 2, True).Write "PK" & Chr(5) & Chr(6) _
  & String(18, Chr(0))

'start copying the files from the source folder to the zip file
Set zip = app.NameSpace(zipfile)
zip.CopyHere app.NameSpace(fldr).Items     '<- runs asynchronously!

'wait for CopyHere to finish
Do
  WScript.Sleep 100
Loop Until zip.Items.Count = cnt