压缩：

FunctionfZip(sSourceFolder,sTargetZIPFile)

'ThisfunctionwilladdallofthefilesinasourcefoldertoaZIPfile

'usingWindows'nativefolderZIPcapability.

DimoShellApp,oFSO,iErr,sErrSource,sErrDescription

SetoShellApp=CreateObject("Shell.Application")

SetoFSO=CreateObject("Scripting.FileSystemObject")

'ThesourcefolderneedstohaveaontheEnd

IfRight(sSourceFolder,1)<>""ThensSourceFolder=sSourceFolder&""

OnErrorResumeNext

'IfatargetZIPexistsalready,deleteit

IfoFSO.FileExists(sTargetZIPFile)ThenoFSO.DeleteFilesTargetZIPFile,True

iErr=Err.Number

sErrSource=Err.Source

sErrDescription=Err.Description

OnErrorGoTo0

IfiErr<>0Then

fZip=Array(iErr,sErrSource,sErrDescription)

ExitFunction

EndIf

OnErrorResumeNext

'Writethefileheaderforablankzipfile.

oFSO.OpenTextFile(sTargetZIPFile,2,True).Write"PK"&Chr(5)&Chr(6)&String(18,Chr(0))

iErr=Err.Number

sErrSource=Err.Source

sErrDescription=Err.Description

OnErrorGoTo0

IfiErr<>0Then

fZip=Array(iErr,sErrSource,sErrDescription)

ExitFunction

EndIf

OnErrorResumeNext

'Startcopyingfilesintothezipfromthesourcefolder.

oShellApp.NameSpace(sTargetZIPFile).CopyHereoShellApp.NameSpace(sSourceFolder).Items

iErr=Err.Number

sErrSource=Err.Source

sErrDescription=Err.Description

OnErrorGoTo0

IfiErr<>0Then

fZip=Array(iErr,sErrSource,sErrDescription)

ExitFunction

EndIf

'Becausethecopyingoccursinaseparateprocess,thescriptwilljustcontinue.RunaDO...LOOPtopreventthefunction

'fromexitinguntilthefileisfinishedzipping.

DoUntiloShellApp.NameSpace(sTargetZIPFile).Items.Count=oShellApp.NameSpace(sSourceFolder).Items.Count

WScript.Sleep1500'如果不成功，增加一下秒数

Loop

fZip=Array(0,"","")

EndFunction

CallfZip("C:vbs","c:vbs.zip")

解压缩：

FunctionfUnzip(sZipFile,sTargetFolder)

'CreatetheShell.Applicationobject

DimoShellApp:SetoShellApp=CreateObject("Shell.Application")

'CreatetheFileSystemobject

DimoFSO:SetoFSO=CreateObject("Scripting.FileSystemObject")

'Createthetargetfolderifitisn'talreadythere

IfNotoFSO.FolderExists(sTargetFolder)ThenoFSO.CreateFoldersTargetFolder

'Extractthefilesfromthezipintothefolder

oShellApp.NameSpace(sTargetFolder).CopyHereoShellApp.NameSpace(sZipFile).Items

'Thisisaseperateprocess,sothescriptwouldcontinueeveniftheunzippingisnotdone

'Topreventthis,werunaDO...LOOPonceasecondcheckingtoseeifthenumberoffiles

'inthetargetfolderequalsthenumberoffilesinthezipfile.Ifso,wecontinue.

Do

WScript.Sleep1000‘有时需要更改

LoopWhileoFSO.GetFolder(sTargetFolder).Files.Count<oShellApp.NameSpace(sZipFile).Items.Count

EndFunction