压缩一个文件夹

Question

我正在尝试使用VBScript压缩一个文件夹，但好像无法正常工作。我确定已经正确创建了头文件。

它可以正确地创建实际文件，只是无法压缩文件夹。

有人有什么想法吗？

Sub ArchiveFolder (folder)

    Dim fso, wShell, sApp, zipFile

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set wShell = CreateObject("WScript.Shell")  
    Set sApp = CreateObject("Shell.Application")
    Set zipFile = fso.CreateTextFile(folder & ".zip")

    ' Write zip file header.
    zipFile.Write "PK" & Chr(5) & Chr(6) & String(18, 0)
    zipFile.Close

    sApp.NameSpace(folder & ".zip").CopyHere folder

End Sub

- Cheetah

---

请检查此链接(https://dev59.com/UF4c5IYBdhLWcg3wVpBI)，zip实用程序是用JScript编写的，但您可以将其作为外部进程调用，或者如果您将其与vbscript代码一起放在wsh文件中。 - npocmaka

Answer 1

我在这里找到了答案。魔法就在最后的Do..Loop，脚本会等待 Shell 完成它的工作。

ArchiveFolder "sub\foo.zip", "..\baz"

Sub ArchiveFolder (zipFile, sFolder)

    With CreateObject("Scripting.FileSystemObject")
        zipFile = .GetAbsolutePathName(zipFile)
        sFolder = .GetAbsolutePathName(sFolder)

        With .CreateTextFile(zipFile, True)
            .Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, chr(0))
        End With
    End With

    With CreateObject("Shell.Application")
        .NameSpace(zipFile).CopyHere .NameSpace(sFolder).Items

        Do Until .NameSpace(zipFile).Items.Count = _
                 .NameSpace(sFolder).Items.Count
            WScript.Sleep 1000 
        Loop
    End With

End Sub

- Panayot Karabakalov

---

以上代码工作正常，但在创建 zip 文件后无法将文件复制到其中，提示访问被拒绝。手动打开文件时也遇到相同的错误，请给予建议。 - sanjeeb

Answer 2

请检查您的参数。 folder 必须是您要放入 zip 文件的对象的路径。如果它是文件夹对象，则必须使用 folder.Path，因为文件夹对象的默认方法是 Name，而 CopyHere 无法仅通过名称找到对象。

您可以向函数添加一些调试语句来检查：

WScript.Echo TypeName(folder)
If fso.FolderExists(folder) Then
  WScript.Echo folder & " exists."
Else
  WScript.Echo folder & " doesn't exist."
End If

- Ansgar Wiechers

Answer 3

你可以通过 %comspec% 调用外部的 zip 文件

oShell.Run "%comspec% /c c:\windows\7za.exe a " & oFile &".zip " & oFile & " -tzip",,True

来源 http://www.scriptlook.com/zip-large-files-in-a-directory-2/

- flydean