Сбой большой папки

Я пытаюсь архивировать журналы, чтобы фиксировать прерывистую ошибку, когда мои журналы регулярно перезаписываются. Я хочу архивировать журналы, чтобы обеспечить захват требуемого события.

Я написал то, что кажется функциональным кодом для выполнения этого, однако, если папка очень большая, 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

Ваш код немного сложнее, чем нужно, но он работает в принципе. Причиной сбоев, которые вы испытываете с большими папками, является фиксированная 2-секундная задержка в конце:

WScript.Sleep 2000

CopyHere выполняется асинхронно, что означает, что он работает в фоновом режиме, а script продолжается. Однако после 2 секунд задержки script завершается (и экземпляр Shell.Application с ним), закончил ли CopyHere или нет. Когда у вас много/больших файлов, обработка может занять более 2 секунд.

Вот почему ваш script отлично работает для небольших папок, но не для больших. Копирование просто не завершено, когда script завершается через 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