压缩大文件夹失败 [英] Zipping a large folder fails

问题描述

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

I am trying to archive logs to capture an intermittent fault where my logs are regularly overwritten. I wish to archive the logs to ensure I capture the required event.

我已经编写了看似功能性的代码来执行此操作，但是如果文件夹非常大，则 zip 会失败.如果我将它指向一个较小的目录，它就可以正常工作.没有产生任何错误，如果您能帮助我确定原因，我将不胜感激.

I have written what appears to be funcional code to perform this, however if the folder is very large, the zip fails. If I point it to a smaller directory, it works without issue. There is no error generated, and I would appreciate any assistance in identifying the cause.

因为我以前从未在 VBS 中编程过，如果这看起来是一个简单的问题，我提前道歉.

As I have never programmed in VBS before, I apologise in advance if this seems a simple question.

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 

推荐答案

您的代码比实际需要的要复杂一些，但它在原理上是有效的.导致您遇到大型文件夹失败的原因是最后固定的 2 秒延迟:

Your code is a little more complicated than it needs to be, but it works in principle. What's causing the failures you're experiencing with large folders is the fixed 2 second delay at the end:

WScript.Sleep 2000

CopyHere 异步运行，这意味着它在脚本继续运行时在后台运行.但是，无论 CopyHere 是否完成，脚本都会在 2 秒延迟后终止(以及带有它的 Shell.Application 实例).当您有大量/大文件时，处理时间可能会超过 2 秒.

CopyHere runs asynchronously, meaning that it runs in the background while the script continues. However, after 2 seconds delay the script terminates (and the Shell.Application instance with it), whether CopyHere has finished or not. When you have numerous/large files the processing may well take more than 2 seconds.

这就是为什么您的脚本适用于小文件夹，但不适用于大文件夹的原因.当脚本在 2 秒后终止时，复制还没有完成.

That's why your script works fine for small folders, but not for large ones. The copying simply isn't finished when the script terminates after 2 seconds.

为避免这种情况，将固定延迟替换为比较已处理文件数与总文件数的检查:

To avoid this, replace the fixed delay with a check that compares the number of processed files to the total file count:

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

这篇关于压缩大文件夹失败的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！