用vbs实现zip功能的脚本

压缩： 
Function fZip(sSourceFolder,sTargetZIPFile) 
'This function will add all of the files in a source folder to a ZIP file 
'using Windows' native folder ZIP capability. 
Dim oShellApp, oFSO, iErr, sErrSource, sErrDescription 
Set oShellApp = CreateObject("Shell.Application") 
Set oFSO = CreateObject("Scripting.FileSystemObject") 
'The source folder needs to have a \ on the End 
If Right(sSourceFolder,1) <> "\" Then sSourceFolder = sSourceFolder & "\" 
On Error Resume Next  
'If a target ZIP exists already, delete it 
If oFSO.FileExists(sTargetZIPFile) Then oFSO.DeleteFile sTargetZIPFile,True  
iErr = Err.Number 
sErrSource = Err.Source 
sErrDescription = Err.Description 
On Error GoTo 0 
If iErr <> 0 Then    
fZip = Array(iErr,sErrSource,sErrDescription) 
Exit Function 
End If 
On Error Resume Next 
'Write the fileheader for a blank zipfile. 
oFSO.OpenTextFile(sTargetZIPFile, 2, True).Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0)) 
iErr = Err.Number 
sErrSource = Err.Source 
sErrDescription = Err.Description 
On Error GoTo 0 
If iErr <> 0 Then    
fZip = Array(iErr,sErrSource,sErrDescription) 
Exit Function 
End If 
On Error Resume Next  
'Start copying files into the zip from the source folder. 
oShellApp.NameSpace(sTargetZIPFile).CopyHere oShellApp.NameSpace(sSourceFolder).Items 
iErr = Err.Number 
sErrSource = Err.Source 
sErrDescription = Err.Description 
On Error GoTo 0 
If iErr <> 0 Then    
fZip = Array(iErr,sErrSource,sErrDescription) 
Exit Function 
End If 
'Because the copying occurs in a separate process, the script will just continue. Run a DO...LOOP to prevent the function 
'from exiting until the file is finished zipping. 
Do Until oShellApp.NameSpace(sTargetZIPFile).Items.Count = oShellApp.NameSpace(sSourceFolder).Items.Count 
   WScript.Sleep 1500'如果不成功，增加一下秒数 
Loop 
fZip = Array(0,"","") 
End Function  

Call fZip ("C:\vbs","c:\vbs.zip")  

End Function  </div>