压缩一个文件夹 [英] Zip a folder up

问题描述

我正在尝试在 VBScript 中压缩文件夹，但它似乎不起作用.我确定我正确地创建了头文件.

I am trying to ZIP up a folder in VBScript and it doesn't seem to work. I'm certain I am creating the header file correctly.

它正确创建了实际文件，只是不压缩文件夹.

It creates the actual file correctly, just doesn't zip the folder.

任何人都有任何想法:

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

推荐答案

我在此处找到的答案.神奇之处在于最后一个 Do..Loop 脚本等待 Shell 完成它的工作.

The answer I found here. The magic is in the last Do..Loop where the script wait the Shell to do it job.

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

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