压缩(zip)无法创建输出文件 - 错误

时间:2014-10-06 16:54:18

标签: vbscript zip

我正在使用VBscript扫描文件夹,创建zip文件并向其中添加文件(压缩),但是当我在包含大量文件的文件夹上运行脚本时,我收到以下错误:"压缩(zip) )无法创建输出文件"

我的邮政编码如下:

Dim objFSO
Set objFSO= CreateObject("Scripting.FileSystemObject"

Function PreformZip(objFile,target,zip_name, number_of_file)

  Set shell = CreateObject("WScript.Shell")  
  zip_target = target + "\" + zip_name +".zip" 
  If Not objFSO.FileExists(zip_target) Then
    MakePathIfNotExist(target) 
    NewZip(zip_target)
  Else
    If number_of_file=0 Then
        objFSO.DeleteFile(zip_target)
        NewZip(zip_target)
    End if
  End If

  Set zipApp = CreateObject("Shell.Application")
  aSourceName = Split(objFile, "\")
  sSourceName = (aSourceName(Ubound(aSourceName)))
  zip_file_count = zipApp.NameSpace(zip_target).items.Count
  zipApp.NameSpace(zip_target).Copyhere objFile, 16
  On Error Resume Next
  sLoop = 0
  Do Until zip_file_count < zipApp.NameSpace(zip_target).Items.Count
    Wscript.Sleep(100)
    sLoop = sLoop + 1
  Loop
  On Error GoTo 0
End Function

Sub NewZip(zip)
  Set new_zip = objFSO.CreateTextFile(zip)
  new_zip.Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0)  
  new_zip.Close
  Set new_zip = Nothing 
  WScript.Sleep(5000)
End Sub

Function MakePathIfNotExist(DirPath)
Dim FSO, aDirectories, sCreateDirectory, iDirectory

Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists(DirPath) Then
  Exit Function
End If

aDirectories = Split(DirPath, "\")
sCreateDirectory = aDirectories(0)
For iDirectory = 1 To UBound(aDirectories)
  sCreateDirectory = sCreateDirectory & "\" & aDirectories(iDirectory)
  If Not FSO.FolderExists(sCreateDirectory) Then
  FSO.CreateFolder(sCreateDirectory)
  End If
Next
End Function

Function Recursion(DirectoryPath)
Dim FSO : Set FSO = CreateObject("Scripting.FileSystemObject")

If FSO.FolderExists(DirectoryPath) Then Exit Function
Call Recursion(FSO.GetParentFolderName(DirectoryPath))
FSO.CreateFolder(DirectoryPath)
End Function

我首先想到我在创建拉链后没有等待足够长的时间,但我甚至在每次拉链后等待10秒钟后仍尝试使用它仍然会出现同样的错误。

我该如何解决?

如果没有解决方案,是否有其他方法可以制作拉链?该脚本不仅仅供我自己使用,所以我不想在需要安装的软件上使用ro relay吗?

2 个答案:

答案 0 :(得分:0)

虽然Folder.CopyHere方法没有返回值并且没有通知调用程序来指示副本已完成,但您可以等待下一个代码段,我希望您能看到正确的(重新)放置在你的脚本中:

On Error GoTo 0
zipApp.NameSpace(zip_target).Copyhere objFile _
      , 4 +8 +16 +256 +512 +1024
Wscript.Sleep( 100)
On Error GoTo 0

注意:没有等待Do..Loop,这个Wscript.Sleep( 100)足以压缩小文件或者在文件很大的情况下启动进度对话框 - 而且你的脚本会等待它......

注意:没有'On Error Resume Next。如果您不处理错误,请避免调用On Error Resume Next ...

标志使用如下。

Const FOF_SILENT            = &h0004 'ineffective?
Const FOF_RENAMEONCOLLISION = &h0008 'ineffective?
Const FOF_NOCONFIRMATION    = &h0010 '
Const FOF_SIMPLEPROGRESS    = &h0100 'ineffective?
Const FOF_NOCONFIRMMKDIR    = &h0200 '
Const FOF_NOERRORUI         = &h0400 '

不幸的是,在某些情况下,例如压缩(.zip)文件,设计(sic!) by MSDN可能会忽略某些选项标记!

如果FOF_SILENT标记无效,则用户可以取消压缩过程......

如果FOF_RENAMEONCOLLISION标志无效,则不会压缩同名的新文件,现有的zip文件保留以前的版本而不加心;只有现有的文件夹会带来额外的错误信息......

这些也可以修复,但它是另一个问题的主题......

答案 1 :(得分:0)

嗯,经过大量研究后我发现使用shell执行zip时没有办法解决这个问题。

我通过以下方式使用 za7.exe(7-zip)解决了这个问题:

Dim zipParams 
zipParams = "a -tzip"
Dim objShell: Set objShell = CreateObject("WScript.Shell")  
command = zip_exe_location + " " + zipParams + " " + zip_target + " " + SourceFile
objShell.Run Command, 0 ,true 

zip参数中的“a”表示“添加到文件”, -tzip 将文件类型设置为zip。