压缩：
FunctionfZip(sSourceFolder,sTargetZIPFile)
'ThisfunctionwilladdallofthefilesinasourcefoldertoaZIPfile
'usingWindows'nativefolderZIPcapability.
DimoShellApp,oFSO,iErr,sErrSource,sErrDescription
SetoShellApp=CreateObject("Shell.Application")
SetoFSO=CreateObject("Scripting.FileSystemObject")
'Thesourcefolderneedstohavea\ontheEnd
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